From bad53d7f6c1ad7fe8ce1af9812c1d3e35a7c388b Mon Sep 17 00:00:00 2001 From: Thomas Prokscha Date: Tue, 22 Mar 2005 10:33:08 +0000 Subject: [PATCH] Added to repository. --- accel/com/ACCEL.COM | 8 + accel/com/ACCEL_GENERAL_INIT.COM | 33 + accel/com/ACCEL_INIT.COM | 11 + accel/com/ACCEL_PROGR_INIT.COM | 19 + accel/com/DEF_MAKEWRITELOGOUT.CLD | 6 + accel/com/GETAC.COM | 1 + accel/com/GETACG.COM | 1 + accel/com/LINKAC.COM | 31 + accel/com/LINKACD.COM | 16 + accel/com/LINKACV.COM | 76 + accel/com/LINKACVD.COM | 38 + accel/com/LINKACVDL.COM | 38 + accel/com/LINKACVL.COM | 47 + accel/com/LINKPS_MAP.COM | 10 + accel/com/MAKEWRITELOGOUT.FOR | 98 + accel/com/MAKE_E0_LIST.FOR | 167 + accel/com/WRITELOG.COM | 49 + accel/src/ACCEL.FOR | 2377 +++++++ accel/src/ADD_MAP.INC | 118 + accel/src/CALC_FIELD_1.INC | 38 + accel/src/CALC_FIELD_2.INC | 195 + accel/src/CODENUMMERN.LIST | 32 + accel/src/COM_ACCEL.INC | 521 ++ accel/src/COM_BS.INC | 9 + accel/src/COM_DIRS.INC | 15 + accel/src/COM_GEO.INC | 86 + accel/src/COM_HVS.INC | 10 + accel/src/INITIALIZE.INC | 276 + accel/src/MAPMAP.INC | 14 + accel/src/MAP_DEF_1.INC | 43 + accel/src/MAP_DEF_2.INC | 43 + accel/src/MAP_DEF_3.INC | 43 + accel/src/MAP_DEF_4.INC | 43 + accel/src/MAP_DEF_5.INC | 43 + accel/src/MAP_DEF_6.INC | 31 + accel/src/READ_INFO.INC | 113 + accel/src/READ_MAP.INC | 58 + accel/src/RUNGE_KUTTA.INC | 192 + accel/src/SUB_ARTLIST.FOR | 191 + accel/src/SUB_INPUT.FOR | 1020 +++ accel/src/SUB_INTEGR_1.FOR | 743 +++ accel/src/SUB_INTEGR_2.FOR | 551 ++ accel/src/SUB_INTEGR_3.FOR | 553 ++ accel/src/SUB_INTEGR_4.FOR | 553 ++ accel/src/SUB_INTEGR_5.FOR | 553 ++ accel/src/SUB_INTEGR_6.FOR | 1007 +++ accel/src/SUB_OUTPUT.FOR | 1705 +++++ accel/src/SUB_PICTURE.FOR | 336 + mutrack/com/COMPILE.COM | 28 + mutrack/com/COPY.COM | 82 + mutrack/com/FORMUT.COM | 3 + mutrack/com/GETMU.COM | 1 + mutrack/com/GETMUG.COM | 1 + mutrack/com/GETMUM.COM | 1 + mutrack/com/INIT-MUTEST.COM | 11 + mutrack/com/LINKMU.COM | 33 + mutrack/com/LINKMUD.COM | 16 + mutrack/com/LINKMUT.COM | 18 + mutrack/com/LINKMUTV.COM | 46 + mutrack/com/LINKMUV.COM | 82 + mutrack/com/LINKMUVD.COM | 38 + mutrack/com/LINKMUVVD.COM | 53 + mutrack/com/MAKEWRITELOGOUT.FOR | 99 + mutrack/com/MAKE_CODENUMMERN-LIST.COM | 62 + mutrack/com/MAKE_CODENUMMERN-LIST.FOR | 70 + mutrack/com/MUTRACK.COM | 8 + mutrack/com/MUTRACK_GENERAL_INIT.COM | 36 + mutrack/com/MUTRACK_INIT.COM | 12 + mutrack/com/MUTRACK_INTER_INIT_OLD.COM | 28 + mutrack/com/MUTRACK_PROGR_INIT.COM | 22 + mutrack/com/PLOT_BATCH_STATUS.COM | 85 + mutrack/com/READ-EVENTNRS.FOR | 52 + mutrack/com/SUB_LIST.COM | 82 + mutrack/com/SUB_MUTRACK.COM | 3 + mutrack/com/T-MUTRACK.COM | 7 + mutrack/com/WRITELOG.COM | 49 + mutrack/geo_files/GEO_KAMMER_RUN10.INPUT | 144 + .../geo_files/GEO_KAMMER_RUN11_RUN12.INPUT | 194 + .../GEO_KAMMER_RUN11_RUN12_FOR_ELOSS.INPUT | 202 + mutrack/geo_files/GEO_KAMMER_RUN2.INPUT | 109 + mutrack/geo_files/GEO_KAMMER_RUN3-4.INPUT | 109 + mutrack/geo_files/GEO_KAMMER_RUN6-8.INPUT | 115 + mutrack/geo_files/GEO_KAMMER_RUN7_LONG.INPUT | 118 + mutrack/geo_files/GEO_KAMMER_RUN9.INPUT | 113 + mutrack/geo_files/GEO_KAMMER_RUN9_NEW.INPUT | 113 + .../geo_files/GEO_KAMMER_RUN9_NEW_MUONS.INPUT | 139 + .../GEO_KAMMER_RUN9_NEW_PROTONS.INPUT | 148 + .../GEO_KAMMER_RUN9_NEW_PROTONS_OLD.INPUT | 138 + .../geo_files/GEO_KAMMER_RUN_SAMPLE10.INPUT | 144 + mutrack/src/CODENUMMERN.LIST | 52 + mutrack/src/COM_DIRS.INC | 16 + mutrack/src/COM_KAMMER.INC | 224 + mutrack/src/COM_LUNS.INC | 23 + mutrack/src/COM_MUTRACK.INC | 768 +++ mutrack/src/COM_OUTPUT.INC | 23 + mutrack/src/COM_TD_EXT.INC | 20 + mutrack/src/COM_TD_INT.INC | 25 + mutrack/src/COM_WINKEL.INC | 24 + mutrack/src/GEO_TRIGGER.INC | 123 + mutrack/src/INITIALIZE.INC | 464 ++ mutrack/src/MAP_DEF_FO.INC | 50 + mutrack/src/MAP_DEF_L1.INC | 56 + mutrack/src/MAP_DEF_L2ANDFO.INC | 66 + mutrack/src/MAP_DEF_L3.INC | 60 + mutrack/src/MAP_DEF_M2.INC | 51 + mutrack/src/MAP_DEF_SP_1.INC | 38 + mutrack/src/MAP_DEF_SP_2.INC | 32 + mutrack/src/MAP_DEF_SP_3.INC | 32 + mutrack/src/MUTRACK.FOR | 5466 +++++++++++++++++ mutrack/src/MUTRACK_OLD.FOR | 5400 ++++++++++++++++ mutrack/src/MUTRACK_VERSION_2-0-0.INPUT | 532 ++ mutrack/src/READ_MAP.INC | 48 + mutrack/src/READ_MAP_SP.INC | 48 + mutrack/src/SUB_ARTLIST.FOR | 226 + mutrack/src/SUB_ELOSS.FOR | 663 ++ mutrack/src/SUB_INPUT.FOR | 3017 +++++++++ mutrack/src/SUB_INTEGR_FO.FOR | 698 +++ mutrack/src/SUB_INTEGR_L1.FOR | 629 ++ mutrack/src/SUB_INTEGR_L2ANDFO.FOR | 802 +++ mutrack/src/SUB_INTEGR_L3.FOR | 709 +++ mutrack/src/SUB_INTEGR_M2.FOR | 721 +++ mutrack/src/SUB_INTEGR_SP.FOR | 1112 ++++ mutrack/src/SUB_OUTPUT.FOR | 2874 +++++++++ mutrack/src/SUB_PICTURE.FOR | 1842 ++++++ mutrack/src/SUB_TRIGGER.FOR | 928 +++ 125 files changed, 42837 insertions(+) create mode 100644 accel/com/ACCEL.COM create mode 100644 accel/com/ACCEL_GENERAL_INIT.COM create mode 100644 accel/com/ACCEL_INIT.COM create mode 100644 accel/com/ACCEL_PROGR_INIT.COM create mode 100644 accel/com/DEF_MAKEWRITELOGOUT.CLD create mode 100644 accel/com/GETAC.COM create mode 100644 accel/com/GETACG.COM create mode 100644 accel/com/LINKAC.COM create mode 100644 accel/com/LINKACD.COM create mode 100644 accel/com/LINKACV.COM create mode 100644 accel/com/LINKACVD.COM create mode 100644 accel/com/LINKACVDL.COM create mode 100644 accel/com/LINKACVL.COM create mode 100644 accel/com/LINKPS_MAP.COM create mode 100644 accel/com/MAKEWRITELOGOUT.FOR create mode 100644 accel/com/MAKE_E0_LIST.FOR create mode 100644 accel/com/WRITELOG.COM create mode 100644 accel/src/ACCEL.FOR create mode 100644 accel/src/ADD_MAP.INC create mode 100644 accel/src/CALC_FIELD_1.INC create mode 100644 accel/src/CALC_FIELD_2.INC create mode 100644 accel/src/CODENUMMERN.LIST create mode 100644 accel/src/COM_ACCEL.INC create mode 100644 accel/src/COM_BS.INC create mode 100644 accel/src/COM_DIRS.INC create mode 100644 accel/src/COM_GEO.INC create mode 100644 accel/src/COM_HVS.INC create mode 100644 accel/src/INITIALIZE.INC create mode 100644 accel/src/MAPMAP.INC create mode 100644 accel/src/MAP_DEF_1.INC create mode 100644 accel/src/MAP_DEF_2.INC create mode 100644 accel/src/MAP_DEF_3.INC create mode 100644 accel/src/MAP_DEF_4.INC create mode 100644 accel/src/MAP_DEF_5.INC create mode 100644 accel/src/MAP_DEF_6.INC create mode 100644 accel/src/READ_INFO.INC create mode 100644 accel/src/READ_MAP.INC create mode 100644 accel/src/RUNGE_KUTTA.INC create mode 100644 accel/src/SUB_ARTLIST.FOR create mode 100644 accel/src/SUB_INPUT.FOR create mode 100644 accel/src/SUB_INTEGR_1.FOR create mode 100644 accel/src/SUB_INTEGR_2.FOR create mode 100644 accel/src/SUB_INTEGR_3.FOR create mode 100644 accel/src/SUB_INTEGR_4.FOR create mode 100644 accel/src/SUB_INTEGR_5.FOR create mode 100644 accel/src/SUB_INTEGR_6.FOR create mode 100644 accel/src/SUB_OUTPUT.FOR create mode 100644 accel/src/SUB_PICTURE.FOR create mode 100644 mutrack/com/COMPILE.COM create mode 100644 mutrack/com/COPY.COM create mode 100644 mutrack/com/FORMUT.COM create mode 100644 mutrack/com/GETMU.COM create mode 100644 mutrack/com/GETMUG.COM create mode 100644 mutrack/com/GETMUM.COM create mode 100644 mutrack/com/INIT-MUTEST.COM create mode 100644 mutrack/com/LINKMU.COM create mode 100644 mutrack/com/LINKMUD.COM create mode 100644 mutrack/com/LINKMUT.COM create mode 100644 mutrack/com/LINKMUTV.COM create mode 100644 mutrack/com/LINKMUV.COM create mode 100644 mutrack/com/LINKMUVD.COM create mode 100644 mutrack/com/LINKMUVVD.COM create mode 100644 mutrack/com/MAKEWRITELOGOUT.FOR create mode 100644 mutrack/com/MAKE_CODENUMMERN-LIST.COM create mode 100644 mutrack/com/MAKE_CODENUMMERN-LIST.FOR create mode 100644 mutrack/com/MUTRACK.COM create mode 100644 mutrack/com/MUTRACK_GENERAL_INIT.COM create mode 100644 mutrack/com/MUTRACK_INIT.COM create mode 100644 mutrack/com/MUTRACK_INTER_INIT_OLD.COM create mode 100644 mutrack/com/MUTRACK_PROGR_INIT.COM create mode 100644 mutrack/com/PLOT_BATCH_STATUS.COM create mode 100644 mutrack/com/READ-EVENTNRS.FOR create mode 100644 mutrack/com/SUB_LIST.COM create mode 100644 mutrack/com/SUB_MUTRACK.COM create mode 100644 mutrack/com/T-MUTRACK.COM create mode 100644 mutrack/com/WRITELOG.COM create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN10.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN11_RUN12.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN11_RUN12_FOR_ELOSS.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN2.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN3-4.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN6-8.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN7_LONG.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN9.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN9_NEW.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN9_NEW_MUONS.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS_OLD.INPUT create mode 100644 mutrack/geo_files/GEO_KAMMER_RUN_SAMPLE10.INPUT create mode 100644 mutrack/src/CODENUMMERN.LIST create mode 100644 mutrack/src/COM_DIRS.INC create mode 100644 mutrack/src/COM_KAMMER.INC create mode 100644 mutrack/src/COM_LUNS.INC create mode 100644 mutrack/src/COM_MUTRACK.INC create mode 100644 mutrack/src/COM_OUTPUT.INC create mode 100644 mutrack/src/COM_TD_EXT.INC create mode 100644 mutrack/src/COM_TD_INT.INC create mode 100644 mutrack/src/COM_WINKEL.INC create mode 100644 mutrack/src/GEO_TRIGGER.INC create mode 100644 mutrack/src/INITIALIZE.INC create mode 100644 mutrack/src/MAP_DEF_FO.INC create mode 100644 mutrack/src/MAP_DEF_L1.INC create mode 100644 mutrack/src/MAP_DEF_L2ANDFO.INC create mode 100644 mutrack/src/MAP_DEF_L3.INC create mode 100644 mutrack/src/MAP_DEF_M2.INC create mode 100644 mutrack/src/MAP_DEF_SP_1.INC create mode 100644 mutrack/src/MAP_DEF_SP_2.INC create mode 100644 mutrack/src/MAP_DEF_SP_3.INC create mode 100644 mutrack/src/MUTRACK.FOR create mode 100644 mutrack/src/MUTRACK_OLD.FOR create mode 100644 mutrack/src/MUTRACK_VERSION_2-0-0.INPUT create mode 100644 mutrack/src/READ_MAP.INC create mode 100644 mutrack/src/READ_MAP_SP.INC create mode 100644 mutrack/src/SUB_ARTLIST.FOR create mode 100644 mutrack/src/SUB_ELOSS.FOR create mode 100644 mutrack/src/SUB_INPUT.FOR create mode 100644 mutrack/src/SUB_INTEGR_FO.FOR create mode 100644 mutrack/src/SUB_INTEGR_L1.FOR create mode 100644 mutrack/src/SUB_INTEGR_L2ANDFO.FOR create mode 100644 mutrack/src/SUB_INTEGR_L3.FOR create mode 100644 mutrack/src/SUB_INTEGR_M2.FOR create mode 100644 mutrack/src/SUB_INTEGR_SP.FOR create mode 100644 mutrack/src/SUB_OUTPUT.FOR create mode 100644 mutrack/src/SUB_PICTURE.FOR create mode 100644 mutrack/src/SUB_TRIGGER.FOR diff --git a/accel/com/ACCEL.COM b/accel/com/ACCEL.COM new file mode 100644 index 0000000..94e0436 --- /dev/null +++ b/accel/com/ACCEL.COM @@ -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 diff --git a/accel/com/ACCEL_GENERAL_INIT.COM b/accel/com/ACCEL_GENERAL_INIT.COM new file mode 100644 index 0000000..d774fb0 --- /dev/null +++ b/accel/com/ACCEL_GENERAL_INIT.COM @@ -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" +$!============================================================================== diff --git a/accel/com/ACCEL_INIT.COM b/accel/com/ACCEL_INIT.COM new file mode 100644 index 0000000..39da6b6 --- /dev/null +++ b/accel/com/ACCEL_INIT.COM @@ -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" +$!============================================================================== diff --git a/accel/com/ACCEL_PROGR_INIT.COM b/accel/com/ACCEL_PROGR_INIT.COM new file mode 100644 index 0000000..9a7245d --- /dev/null +++ b/accel/com/ACCEL_PROGR_INIT.COM @@ -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" +$!============================================================================== diff --git a/accel/com/DEF_MAKEWRITELOGOUT.CLD b/accel/com/DEF_MAKEWRITELOGOUT.CLD new file mode 100644 index 0000000..798accd --- /dev/null +++ b/accel/com/DEF_MAKEWRITELOGOUT.CLD @@ -0,0 +1,6 @@ +DEFINE VERB MakeWriteLogOut +IMAGE "accel$COMdirectory:MAKEWRITELOGOUT" +PARAMETER P1 + LABEL = RUNNUMBER + VALUE (REQUIRED) + PROMPT = "vierstellige Runnummer" diff --git a/accel/com/GETAC.COM b/accel/com/GETAC.COM new file mode 100644 index 0000000..2ca1772 --- /dev/null +++ b/accel/com/GETAC.COM @@ -0,0 +1 @@ +copy /log PSICLU::USR_SCROOT:[AHOFER]AC_'P1'.*. accel$OUTdirectory:*.*. diff --git a/accel/com/GETACG.COM b/accel/com/GETACG.COM new file mode 100644 index 0000000..65b8ac3 --- /dev/null +++ b/accel/com/GETACG.COM @@ -0,0 +1 @@ +copy /log PSICLU::USR_SCROOT:[GLUECKLER]AC_'P1'.*. accel$OUTdirectory:*.*. diff --git a/accel/com/LINKAC.COM b/accel/com/LINKAC.COM new file mode 100644 index 0000000..22e26df --- /dev/null +++ b/accel/com/LINKAC.COM @@ -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 +$!============================================================================== diff --git a/accel/com/LINKACD.COM b/accel/com/LINKACD.COM new file mode 100644 index 0000000..cdb99eb --- /dev/null +++ b/accel/com/LINKACD.COM @@ -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 diff --git a/accel/com/LINKACV.COM b/accel/com/LINKACV.COM new file mode 100644 index 0000000..37416f9 --- /dev/null +++ b/accel/com/LINKACV.COM @@ -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 +$!============================================================================== diff --git a/accel/com/LINKACVD.COM b/accel/com/LINKACVD.COM new file mode 100644 index 0000000..3bae8b9 --- /dev/null +++ b/accel/com/LINKACVD.COM @@ -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 diff --git a/accel/com/LINKACVDL.COM b/accel/com/LINKACVDL.COM new file mode 100644 index 0000000..00ac807 --- /dev/null +++ b/accel/com/LINKACVDL.COM @@ -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 diff --git a/accel/com/LINKACVL.COM b/accel/com/LINKACVL.COM new file mode 100644 index 0000000..7ac30a7 --- /dev/null +++ b/accel/com/LINKACVL.COM @@ -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 diff --git a/accel/com/LINKPS_MAP.COM b/accel/com/LINKPS_MAP.COM new file mode 100644 index 0000000..61d4c21 --- /dev/null +++ b/accel/com/LINKPS_MAP.COM @@ -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 diff --git a/accel/com/MAKEWRITELOGOUT.FOR b/accel/com/MAKEWRITELOGOUT.FOR new file mode 100644 index 0000000..468ffbc --- /dev/null +++ b/accel/com/MAKEWRITELOGOUT.FOR @@ -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 + diff --git a/accel/com/MAKE_E0_LIST.FOR b/accel/com/MAKE_E0_LIST.FOR new file mode 100644 index 0000000..95fc55f --- /dev/null +++ b/accel/com/MAKE_E0_LIST.FOR @@ -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 + + diff --git a/accel/com/WRITELOG.COM b/accel/com/WRITELOG.COM new file mode 100644 index 0000000..b542195 --- /dev/null +++ b/accel/com/WRITELOG.COM @@ -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'" diff --git a/accel/src/ACCEL.FOR b/accel/src/ACCEL.FOR new file mode 100644 index 0000000..045e0aa --- /dev/null +++ b/accel/src/ACCEL.FOR @@ -0,0 +1,2377 @@ +c******************************************************************************* +c - bei MUTRACK kann Graphik auch im Batchjob erstellt werden! +c +c - NTP_DEBUG einrichten. +c +c - bei StartFlaeche.EQ.1 immer E0==0 setzen (gegebenenfalls mit Kommentarausgabe) +c +c - S1G1, S1G2, G1G2 einfuehren. (bei der 1. Ueberquerung der Gitter mit t<>0. +c zu fuellen. +c******************************************************************************* + + + OPTIONS /EXTEND_SOURCE + +c=============================================================================== + program ACCEL +c=============================================================================== + +c Deklarationen: + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + INCLUDE 'accel$sourcedirectory:COM_GEO.INC' + INCLUDE 'accel$sourcedirectory:COM_HVs.INC' + INCLUDE 'accel$sourcedirectory:COM_Bs.INC' + + +c die SCHLEIFENVARIABLEN und damit zusammenhaengendes (in der Reihenfolge, wie +c sie in den 'do 200 ...'-Schleifen auftreten). +c (Common-Bloecke werden fuer die NTupel-Ausgabe benoetigt) + +c - Masse und Ladung: + + real m, m_ ! Masse, Laufvariable fuer Massen-Schleife + real q, q_ ! Ladung, Laufvariable fuer Ladungs-Schleife + + +c - Startparameter: + +c integer randomloop_ ! Laufvariable fuer zufallsverteilte Starts + real E0_ ! Laufvariable fuer Startenergie_Schleife + real theta0_ ! Laufvarialbe fuer Startwinkel-Schleife + real Sin_theta0, Cos_theta0 ! Startwinkel gegen x-Achse + real phi0_ ! Laufvariable fuer Startwinkel-Schleife + real Sin_phi0, Cos_phi0 ! azimuthaler Startwinkel (phi0=0: y-Achse) + real y0_ ! Laufvariable fuer Startpositions_Schleife + real z0_ ! Laufvariable fuer Startpositions_Schleife + real r0 ! Radius beim Wuerfeln der Startposition + real phi_r0 ! Winkel beim Wuerfeln der Startposition + + ! x0(3),v0(3),E0,theta0,phi0 werden in 'COM_ACCEL.INC' declariert + + +c allgemeine Trajektoriengroessen + + real dt ! zeitl. Aenderung + real v_xy ! Geschwindigkeit in x/y-Ebene + real v0_Betrag + real Ekin ! kinetische Energie + COMMON /Ekin/ Ekin + real radiusQuad ! RadiusQuadrat + real rQuadHeShield ! RadiusQuadrat (innen) + real x40(2:3) ! auf x = 40 mm extrapolierter Ort (FUER NTP_40mm) + real t40 ! auf x = 40 mm extrapolierte Zeit (FUER NTP_40mm) + common/xt40/ x40,t40 ! fuer NTupel + +c Variablen fuer den allgemeinen Programmablauf: + + character uhrzeit*8 + + integer percent_done + integer zaehler ! Zaehler fuer Monitoring der Trajektorie mittels + ! GRAPHICS und DEBUG + logical flag_ok ! logische Hilfsvariable + integer okStepsCounter ! fuer die Berechnung der durchscnittlichen Anzahl + ! Rechenschritte bis zum Ziel + + logical alreadyTested, wireHit ! Fuer Ueberpruefung von Gitter-Treffern + real distToWire(2) + + integer i ! integer-Hilfsvariable + real help1,help2,help3,help4 ! real-Hilfsvariablen + + character helpChar*7, ant*1 + character HistogramTitle*19 /'Startort-Verteilung'/ + + real yAbs,zAbs ! = abs(x(2)),abs(x(3)) + real yWire ! y-Position von Gitterstaeben + + real xMarke,yMarke,zMarke ! Grenzen des Bereiches mit entschaerfter + ! Fehlerbetrachtung + logical reducedAccur + COMMON /reducedAccur/ reducedAccur + + integer lunZwi(0:1) /lunZwi1,lunZwi2/, lunIndx /1/ + integer mappe0,mappe + + logical calcMap(6) ! gibt an, welche Mappen noch zu rechnen sind + DATA calcMap / .false.,.false.,.false.,.false.,.false.,.false. / + + +c Variablen fuer Test, ob Targethalter getroffen wurde: + + real TgtFactorY, TgtFactorZ + real TgtConstY , TgtConstZ + + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000) ! Koordinatenfelder fuer die + real yKoord(1000) ! Graphikausgabe + real zKoord(1000) ! + integer nKoord ! Anzahl der Koordinaten + + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord ! fuer Graphikaufruf + + +c Variablen fuer HBOOK und PAW: + + integer istat ! fuer HBOOK-Fehlermeldungen + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory ! Der Arbeitsbereich fuer HBOOK + + +c Konstanten: + + real c ! Lichtgeschwindigkeit in mm/ns + real meanLifeTime ! mittlere Myon-Lebensdauer in ns + + parameter (c = 299.7925, meanLifeTime = 2197) + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER GEHT DER PROGRAMMTEXT RICHTIG LOS +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c Initialisierungen: + + INCLUDE 'accel$sourcedirectory:INITIALIZE.INC' + + +c Einlesen der Parameter aus 'ACCEL.INPUT' und Setzen der entsprechenden +c Voreinstellungen (liest auch die INFO-files der Potentialmappen): + + call read_inputFile + rQuadHeShield = rHeShield*rHeShield + + +c Grenzen des Bereiches mit entschaerfter Fehlerbetrachtung definieren: + + xMarke = xEnd_TgtHolder + 1 + yMarke = Dy_Foil - 1 + zMarke = Dz_Foil - 1 + + +c falls Bildschirmausgabe verlangt ist, etwas Abstand schaffen: + + write(*,*) + if (n_outWhere.GE.2) then + do i = 1, 5 + write(*,*) + enddo + endif + + +c Anfangs-Informationen ausgeben und abfragen, ob Einstellungen ok sind. Alle +c Ausgabefiles initialisieren: + + call initialize_output + + +c CERN-Pakete initialisieren (Groesse des COMMONblocks /PAWC/ uebermitteln): + + call HLIMIT(HB_memsize) + + +c Graphikausgabe initialisieren: + + if (GRAPHICS) then + CALL MZEBRA(-3) + CALL MZPAW (HB_memsize,' ') + call masstab_setzen + CALL HPLSET ('VSIZ',.6) ! AXIS VALUES SIZE + CALL HPLSET ('TSIZ',.7) ! HISTOGRAM TITLE SIZE + if (random_pos) then + if (random_y0z0_equal.OR.random_y0z0_Gauss) then + CALL HBOOK2 (50,HistogramTitle, + + 100, -StartBreite/2., StartBreite/2., + + 100, -StartHoehe /2., StartHoehe /2., 20.) + else + CALL HBOOK2 (50,HistogramTitle, + + 100, -StartRadius, StartRadius, + + 100, -StartRadius, StartRadius, 20.) + endif + else + CALL HBOOK2 (50,HistogramTitle, + + 100, max(par(1,yPos),5.), max(par(2,yPos),5.), + + 100, max(par(1,zPos),5.), max(par(2,zPos),5.), 20.) + endif + +c Textfond waehlen! (-> keine Proportionalschrift!) + endif + + +c NTP-relevante Befehle: + + !c Datei fuer NTupelausgabe oeffnen: + call HROPEN(lunNTP,'ACCEL',outDir//':'//filename//'.NTP', + + 'N',1024,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)'error ',istat,' opening HBOOK-file' + write(*,*) + STOP + endif + call HBNT(idNTP,filename,'D') ! Disk resident CWN buchen + + !c die Bloecke des CWN definieren: + + if (NTP_MISC) then + call HBNAME(idNTP,'LOOP',schleifenNr,'loop[1,1000]:u,'// + + 'startNr[1,100000]:u,Mappe[1,6]:u,steps[0,100000]:u') + endif + + if (NTP_Start.OR.random_pos) call HBNAME(idNTP,'x0',x0, + + 'x0,y0,z0') +c + 'x0:r*4:20:[-10,30],y0:r*4:20:[-40,40],z0:r*4:20:[-40,40]') + if (NTP_Start) call HBNAME(idNTP,'v0',v0,'vx0,vy0,vz0') + if (NTP_Start.OR.random_E0) call HBNAME(idNTP,'E0',E0,'E0') + if (NTP_Start.OR.random_angle) call HBNAME(idNTP,'angle0',theta0, + + 'theta0,phi0') +c + 'theta0:r*4:20:[0,180],phi0:r*4:20:[0,360]') ! theta0,phi0 + + if (useDecay) call HBNAME(idNTP,'lifetime',lifetime,'lifetime:r') + + call HBNAME(idNTP,'dest',gebiet,'Gebiet[0,4]:u,dest[-10,10]:i') + + call HBNAME(idNTP,'Traj',t,'t,x,y,z,vx,vy,vz') + if (NTP_Stop) call HBNAME(idNTP,'Ekin',Ekin,'Ekin') + if (NTP_40mm) call HBNAME(idNTP,'x=40mm',x40, + + 'y40,z40,t40') + + +c - - - - - - - - - - +c folgendes noch einrichten: (durch verlegen aus 'LOOP') +c +c if (NTP_debug) call HBNAME(idNTP,'DEBUG',startNr[1,100000]:u,'// +c + 'Gebiet[0,Gebiete_Anzahl]:u,Mappe[1,6]:u,'// +c + 'steps[0,MaxSteps+100]:u') +c +c if (NTP_Koord) then ! alle Koordinaten in NTP aufnehmen +c Call HBNAME(idNTP,'koord',Koord_NTP, +c + 'tTgt ,xTgt ,yTgt ,zTgt ,vxTgt ,vyTgt ,vzTgt ,ETgt ,'// +c + 'tGr1 ,xGr1 ,yGr1 ,zGr1 ,vxGr1 ,vyGr1 ,vzGr1 ,EGr1 ,'// +c + 'tGr1 ,xGr1 ,yGr1 ,zGr1 ,vxGr1 ,vyGr1 ,vzGr1 ,EGr1 '// +c endif +c - - - - - - - - - - + + +c die Einsprungposition fuer den Beginn der Trajektorienberechnungen setzen: + + if (x0(1).LT.xEndMap1) then + mappe0 = 1 + elseif (x0(1).LT.xEndMap2) then + mappe0 = 2 + elseif (x0(1).LT.xEndMap3) then + mappe0 = 3 + elseif (x0(1).LT.xEndMap4) then + mappe0 = 4 + elseif (x0(1).LT.xEndMap5) then + mappe0 = 5 + else + mappe0 = 6 + endif + + +c Erstellen des .INFO-files: + + call make_INFOfile + + +c Erstellen der Hilfsgroesen fuer den Test, ob Targethalter getoffen wurde: + + TgtFactorY = (innerDy2_TgtHolder-innerDy1_TgtHolder)/(xEnd_TgtHolder-xFoil) + TgtConstY = innerDy1_TgtHolder - xFoil*TgtFactorY + + TgtFactorZ = (innerDz2_TgtHolder-innerDz1_TgtHolder)/(xEnd_TgtHolder-xFoil) + TgtConstZ = innerDz1_TgtHolder - xFoil*TgtFactorZ + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c ab hier beginnen die Schleifen. (N.B.: die Laufvariable darf kein Feldelement +c sein) +c +c Besonderheit der Massen- und der Ladungsschleife: +c Wurde im INPUT-File in der Variablen 'artList' eine Teilchenart spezifi- +c ziert (-> 'artList_defined'), so werden die Parameter Masse und Ladung nicht +c entsprechend den Inhalten von par(n,mass) bzw. par(n,charge) eingestellt, +c sondern entsprechend den zu den Teilchenarten gehoerenden Werten fuer diese +c Groessen. In diesem Fall besteht die Massenschleife aus genau einem (Leer-) +c Durchlauf, waehrend die Ladungsschleife fuer jede Teilchenart einen Durchlauf +c macht, in welcher dann die Einstellung von Ladung UND Masse stattfindet. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Masse und Ladung: +c ----------------- + + do 200 m_ = par(1,mass),par(2,mass),par(3,mass) ! MASSE + if (.NOT.artList_defined) then + m = m_ + parWert(mass) = m + endif + + do 200 q_ = par(1,charge),par(2,charge),par(3,charge) ! LADUNG + if (.NOT.artList_defined) then + q = q_ + parWert(charge) = q + else + ArtNr = Art_Nr(q_) + m = Art_Masse(ArtNr) + q = Art_Ladung(ArtNr) + parWert(mass) = m + parWert(charge) = q + endif + Energie_Faktor = m / (2.*c*c) + Beschl_Faktor = q / m * c*c + + if (useDecay) then ! 'useDecay' setzt 'artList_defined' voraus! + if (ArtNr.LE.4) then ! es ist ein Myon involviert + useDecay_ = .true. + else ! kein Myon involviert + useDecay_ = .false. + endif + endif + + +c Spannungen: +c ----------- + + do 200 UTgt = par(1,UTarget),par(2,UTarget),par(3,UTarget) ! U(TARGET) + parWert(UTarget) = UTgt + + do 200 UGua = par(1,UGuard),par(2,UGuard),par(3,UGuard) ! U(GUARD) + parWert(UGuard) = UGua + + do 200 UG1 = par(1,UGi1),par(2,UGi1),par(3,UGi1) ! U(GITTER) + parWert(UGi1) = UG1 + +c Magnetfelder: +c ------------- + + do 200 B_Helm = par(1,BHelm),par(2,BHelm),par(3,BHelm) ! Helmholtzs + parWert(BHelm) = B_Helm + + do 200 B_TD = par(1,BTD),par(2,BTD),par(3,BTD) ! TD-Spule + parWert(BTD) = B_TD + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Die in den ab hier beginnenden Startparameter-Schleifen eingestellten Start- +c werte werden bei Verwendung entsprechender Zufallsverteilungen als Offset fuer +c die letztendlichen Startwerte verwendet: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Startparameter: +c --------------- + + do 200 E0_ = par(1,ener),par(2,ener),par(3,ener) ! E0 +c if (.NOT.random_E0) E0 = E0_ + E0 = E0_ + +c das hier folgende wurde eingefuegt um fuer die Auswertung der Startenergie- +c verteilung variabler in der Aufteilung der Startenergieintervalle zu sein. +c (Zuvor musste man um variable Binbreiten zu haben mehrere Accel- und +c Mutrack-Simulationen durchlaufen lassen). + + if (E0InterFromFile) then + lowerE0 = E0Low(nInt(E0_)) + upperE0 = E0Low(nint(E0_+1)) + endif + +c das hier folgende ist eine spezielle Erweiterung fuer die Auswertung der +c Energieverluste der hoeherenergetischen Myonen. Hier wird aus sigma(tof) +c (= 1.6 ns) in Abhaengigkeit der Energie ein sigma(E0) berechnet. Dies ist +c gedacht fuer Flugzeitemessungen M3S1 bei Fluglaengen von 1 m unter +c Vernachlaessigung der Auswirkungen der Felder in den Linsen und im Spiegel: + + if (adjustSigmaE0) then + help1 = (E0_ + UTgt) + sigmaE0 = 0.0118 * help1**1.5 + write(lunLOG,*) 'UTgt,E0_,sigmaE0 = ',UTgt,E0_,sigmaE0 + endif + + do 200 theta0_ = par(1,thetAng),par(2,thetAng),par(3,thetAng) ! theta0 + if (.NOT.random_angle) then + theta0 = theta0_ + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + + do 200 phi0_ = par(1,phiAng),par(2,phiAng),par(3,phiAng) ! phi0 + if (.NOT.random_angle) then + phi0 = phi0_ + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + do 200 y0_ = par(1,yPos),par(2,yPos),par(3,yPos) ! y0 + if (.NOT.random_pos) x0(2) = y0_ + + do 200 z0_ = par(1,zPos),par(2,zPos),par(3,zPos) ! z0 + if (.NOT.random_pos) x0(3) = z0_ + +c die folgenden parWert(n) werden u.U. in der 'Zufallsschleife' weiter unten +c abgeaendert. Hier werden sie in jedem Fall fuer Tabellenausgaben, Debug- +c angelegenheiten, Erstellen des .INFO-files u.s.w. erst einmal mit den +c aktuellen Werten der entsprechenden Schleifen gefuellt: + + parWert(ener) = E0_ + parWert(thetAng) = theta0_ + parWert(phiAng) = phi0_ + parWert(yPos) = y0_ + parWert(zPos) = z0_ + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die Befehle, die zu Beginn jeder neuen Schleife faellig sind: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + SchleifenNr = SchleifenNr + 1 ! Schleifen zaehlen + okStepsCounter = 0 ! Zaehler fuer Ermittlung der durchschnittlichen + ! Anzahl Schritte bis zum Ziel + + +c Die Statistikspeicher resetten: +c Falls nur ein Teilchenstart pro Schleife erfolgt, nimm die Statistik ueber +c alle Schleifen. Dann erfolgt der Reset nur bei der ersten Schleife: + + flag_ok = (.NOT.(OneStartPerLoop .AND. SchleifenNr.GT.1)) + + if (flag_ok) call reset_statistics + + +c Die Kammer zeichnen: +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Zeichne die Kammer dann also nur bei der ersten Schleife. + + if (GRAPHICS .AND. flag_ok) then + CALL IZPICT ('CHAMBER','M') ! ERZEUGEN VON BILDERN IM PAWC-COMMON-BLOCK + CALL IZPICT ('HISTO','M') + CALL IZPICT ('TEXT','M') + call plot_chamber + call Graphics_Text ! Text fuer Textwindow erstellen + call text_plot ! Ausgabe des Textes + endif + + +c Ausgabe der aktuellen Settings: +c Auch dies im Falle von 'OneStartPerLoop' nur bei der ersten Schleife: + + if ((n_outWhere.NE.0 .OR. smallLogFile) .AND. flag_ok) then + call output_new_loop + endif + + +c Oeffnen der temporaeren files: + +c - das Startparameterfile: +c Speicherbedarf pro record in longwords: +c x0,v0,E0,theta0,phi0 = +c 3 + 3+ 1+ 1 + 1 = 9 + + open(lunStart,file=filename//'_start.tmp',defaultfile=TMPDir, + + form='unformatted',recl=9,status='scratch') + + +c - das File fuer die Lebensdauern: + + if (UseDecay_) open (lunDecay,file=filename//'_decay.tmp',defaultfile=TMPDir, + + form='unformatted',status='scratch',recl=1) + + +c - die Zwischenspeicherungsfiles: +c Speicherbedarf pro record in longwords: +c steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt = +c .5 +1+3+3+ .5 + .5 + .5 + .5 + .5 + 1 = 11 + + open (lunZwi1,file=filename//'_zwi1.tmp',defaultfile=TMPDir, + + form='unformatted',status='scratch',recl=11) + open (lunZwi2,file=filename//'_zwi2.tmp',defaultfile=TMPDir, + + form='unformatted',status='scratch',recl=11) + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c Wuerfeln der Startparameter fuer die Teilchen dieser Schleife: +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + write (*,*) 'Wuerfeln der Startparameter ...' + +c DEBUG beruecksichtigen: + + if (DEBUG) write (lunLOG,*) '>>>>>>> Erstellen der Startparameter <<<<<<<' + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c gegebenenfalls werden hier die in den Startparameterschleifen eingestellten +c Startwerte mit einem zufallsverteilten Anteil ueberlagert: +c Sind keine Zufallsverteilungen verlangt macht die 'Zufallsschleife' genau +c einen Durchlauf. (-> n_par(0) == 1) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + do 100 start_nr = 1, n_par(0) + + if (random_E0) then ! random_ENERGIE + if (random_E0_equal) then ! -> gleichverteilt +276 if (E0InterFromFile) then + E0 = lowerE0 + (upperE0 - lowerE0)*ran(seed) + else + E0 = E0_ + lowerE0 + (upperE0 - lowerE0)*ran(seed) + endif + if (E0.LT.0) goto 276 + elseif (random_E0_gauss) then ! -> gaussverteilt +277 call Gauss_Verteilung(sigmaE0,help1) + E0 = E0_ + help1 + if (E0.LT.0) goto 277 + endif + parWert(ener) = E0 + endif + + if (random_pos) then ! random_POSITION + if (random_y0z0_equal) then ! -> rechteckig, gleichverteilt + x0(2) = StartBreite * (ran(seed)-.5) + x0(3) = StartHoehe * (ran(seed)-.5) + elseif (random_y0z0_Gauss) then ! -> rechteckig, Gaussverteilt +278 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + if (abs(x0(2)).GT.StartBreite/2.) goto 278 + x0(3) = r0 * sind(phi_r0) + if (abs(x0(3)).GT.StartHoehe/2.) goto 278 + elseif (random_r0_equal) then ! -> rund, gleichverteilt + r0 = StartRadius * sqrt(ran(seed)) + phi_r0= 360. * ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + elseif (random_r0_Gauss) then ! -> rund, Gaussverteilt +279 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + if (r0.GT.StartRadius) goto 279 + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + endif + x0(2) = y0_ + x0(2) + x0(3) = z0_ + x0(3) + parWert(yPos) = x0(2) + parWert(zPos) = x0(3) + endif + + if (StartFlaeche.EQ.1) then + ! Ziehe alle Teilchen auf jeweils 'naechstem' Gitterstab zusammen. + ! Wuerfle Startposition auf der Oberflaeche des Gitterstabes in + ! der x-y-Ebene gleichverteilt. Lasse Teilchen 1e-5 Radien ueber + ! der Drahtoberflaeche starten. + if (.NOT.random_pos) x0(2) = y0_ + if (abs(x0(2)).LE.innerDy_Gridframe1 .AND. abs(x0(3)).LE.innerDz_Gridframe1) then + ywire = nint((x0(2)-y_Pos_firstWire1)/distance_wires1)*distance_wires1 + y_Pos_firstWire1 + help1 = 360.*ran(seed) + x0(1) = xPosition_Grid1 + 1.00001*rWires1*sind(help1) + x0(2) = ywire + 1.00001*rWires1*cosd(help1) + ! (z-Komponente bleibt unveraendert) + endif + parWert(yPos) = x0(2) + parWert(zPos) = x0(3) + endif + + if (StartFlaeche.EQ.2) then + ! wie bei StartFlaeche.EQ.1 + if (.NOT.random_pos) x0(2) = y0_ + if (abs(x0(2)).LE.innerDy_Gridframe2 .AND. abs(x0(3)).LE.innerDz_Gridframe2) then + ywire = nint((x0(2)-y_Pos_firstWire2)/distance_wires2)*distance_wires2 + y_Pos_firstWire2 + help1 = 360.*ran(seed) + x0(1) = xPosition_Grid2 + 1.00001*rWires2*sind(help1) + x0(2) = ywire + 1.00001*rWires2*cosd(help1) + ! (z-Komponente bleibt unveraendert) + endif + parWert(yPos) = x0(2) + parWert(zPos) = x0(3) + endif + + if (graphics) then + if (abs(x0(2)).LE.20 .AND. abs(x0(3)).LE.20) then + CALL HFILL (50,x0(2),x0(3),1.) + endif + endif + + if (random_angle) then ! random_WINKEL +4462 if (random_lambert) then ! -> Lambert-verteilt + call lambert_verteilung(StartLambertOrd, + + Cos_theta0,Sin_theta0) + theta0 = acosd(Cos_theta0) + elseif (random_gauss) then + call Gauss_Verteilung_theta(sigmaWinkel,theta0) + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + + phi0 = 360.*ran(seed) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + + if (angle_offset) then + +c -> Es soll aus gewuerfelter Startrichtung (theta0,phi0) und durch die Winkel- +c schleifen vorgegebenen Startrichtung (theta0_,phi0_) die tatsaechliche +c Startrichtung berechnet werden. Dafuer werden die gewuerfelten Winkel als +c 'Streuwinkel' betrachtet. +c Vorgehensweise: +c Es werden die Komponenten eines Geschwindigkeitsvektors mit Betrag=1 und durch +c theta0_,phi0_ bestimmter Richtung berechnet. Danach werden die Komponenten des +c mit theta0,phi0 gestreuten Geschwindigkeitsvektors und die zugehoerigen Winkel +c gewonnen, die dann als neudefinierte theta0 und phi0 fuer die tatsaechlichen +c Startwinkel verwendet werden. Das alles geschieht vollkommen analog zur +c Winkelaufstreuung in der Triggerfolie im Programm 'MUTRACK'. +c ('v' wird als Hilfsvariable missbraucht). + + ! Berechnen der 'Geschwindigkeitskomponenten': + v(1) = cosd(theta0_) + help1 = sind(theta0_) + v(2) = help1 * cosd(phi0_) + v(3) = help1 * sind(phi0_) + ! v_xy ist stets groesser 0 ausser wenn die Zentralrichtung + ! senkrecht nach oben oder unten gerichtet ist. Diese Wahl ist + ! aber sowieso wenig sinnvoll: + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) + if (v_xy.EQ.0.) then + write(*,*) + write(*,*)' Bei Zufallsverteilung fuer Startwinkel darf die durch die Winkelschleifen' + write(*,*)' vorgegebene Zentralrichtung nicht senkrecht nach oben oder nach unten weisen!' + write(*,*)' -> STOP' + STOP + endif + ! berechne neue 'Geschwindigkeitskomponenten': + help1 = v(1) + help2 = v(2) + help3 = Sin_theta0*Cos_phi0/v_xy + help4 = Sin_theta0*Sin_phi0 + v(1) = Cos_theta0*help1 - help3*help2 - help4*help1*v(3)/v_xy + if (v(1).LT.0.) goto 4462 + v(2) = Cos_theta0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = Cos_theta0*v(3) + help4*v_xy + ! Berechne tatsaechlichen Startwinkel: + if (v(2).EQ.0. .AND. v(3).EQ.0.) then + if (v(1).GE.0) then + theta0 = 0. + else + theta0 = 180. + endif + phi0 = 0. + else + theta0 = acosd(v(1)) + phi0 = atan2d(v(3),v(2)) + if (phi0.LT.0) phi0 = phi0+360. + endif + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + if (theta0.GT.90.) goto 4462 + + parWert(thetAng) = theta0 + parWert(phiAng) = phi0 + endif + +c Bei Starts von Gitter 1 Startwinkel umrechnen (vielleicht auf +c Oberflaechennormale am Startort beziehen?) + + if (StartFlaeche.EQ.1) then + ! + ! + ! + endif + + +c Berechnen der Start-Geschwindigkeitskomponenten: + + v0_Betrag = sqrt(E0/Energie_Faktor) + + v0(1) = v0_Betrag * Cos_theta0 + v0(2) = v0_Betrag * Sin_theta0 * Cos_phi0 + v0(3) = v0_Betrag * Sin_theta0 * Sin_phi0 + + if (v0(1).LT.0) then + write(*,*) + write(*,*) ' >>>> v0(x) negativ!' + write(*,*) + STOP + endif + + +c Schreiben der Startparameter in das (temporaere) Startparameterfile: + + write(lunStart) x0,v0,E0,theta0,phi0 + + +c gegebenenfalls die Lebensdauer wuerfeln und in das entsprechende File schreiben: + + if (UseDecay_) then +2453 lifeTime = -meanlifeTime * Log(Ran(seed) + 1.0E-37) + if (lifeTime.LE.0.) goto 2453 + write(lunDecay) lifetime + endif + + +c die DEBUG-Daten ausgeben: + + if (Debug .AND. start_nr.LE.DEBUG_Anzahl) call output_new_particle + + +c Festlegen des 1. Zeitschritts (beim ersten Versuch 0.1 mm in x-Richtung): + + if (v0(1).GT.0) then + dt = 0.1/v0(1) + if (dt.LT.dtsmall) dt = .01 + else + dt = .01 + endif + + +c die auf x=40 mm extrapolierten Koordinaten resetten: + + if (NTP_40mm) then + x40(2) = 0. + x40(3) = 0. + t40 = 0. + endif + + +c schreibe die relevanten Daten in das entsprechende Zwischenspeicherungsfile: + + ! Startortverteilung in y-z-Ebene muss auf Mappenverhaeltnisse skaliert werden: + help2 = x0(2) / scaleFactor + help3 = x0(3) / scaleFactor + write(lunZwi(lunIndx)) 0,0.,x0(1),help2,help3,v0,100+Mappe0, 0, 0,Gebiet0,Mappe0,dt + ! = steps,t,x ,v ,destiny,zaehler,n_dtsmall,Gebiet ,lastMap ,dt + +100 continue ! naechstes Startparameterset festlegen + + if (graphics) call schnitt_plot ! Ausgabe der Graphik der Startverteilung + + if (Debug) then + write(lunLOG,'(x,79(''-''))') + write(lunLOG,1001) 'STEP','T','X','Y','Z','Vx','Vy','Vz','E' + write(lunLOG,'(x,79(''-''))') + endif +1001 format (T2,A,T17,A,T25,A,T32,A,T39,A,T47,A,T54,A, + + T61,A,T71,A) + + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c jetzt starten die Projektile: +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + mappe = mappe0 + goto (1,2,3,4,5,6) mappe + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der 1. Mappe (dx = 0.125 mm, dy = 0.125 mm, dz = 0.500 mm) +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +1 calcMap(1) = .false. + if (HVs_from_map) then + call read_map_1 + else + call add_map_1 + endif + start_Nr = 0 + + +c Zurueckspulen der Zwischenspeicherungsfiles: + + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien vorbereiten: + + if (log_percent) then + call time(uhrzeit) + percent_done = 0. + write(*,2001)'map1: ',Uhrzeit,' %: 0' + else + write(*,*) 'integrating ...' + endif +2001 format ($,x,A,A,A) + + +c DEBUG beruecksichtigen: + + if (DEBUG) write (lunLOG,*) '>>>>>>> MAPPE 1 <<<<<<<' + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c hier starten die Projektile in die 1. Potentialmappe: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Trajektorienparameter: + +11 read(lunZwi(lunIndx),END=99999) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + if (UseDecay_) read(lunDecay) lifetime + start_nr = start_nr + 1 + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien: + + if (log_percent) then + if (100.*real(start_nr)/real(n_par(0)).GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,2002) percent_done + endif + endif +2002 format ($,'+',I3) + + +c beruecksichtige nur die Teilchen, die sich gerade in der aktuellen Mappe auf- +c halten: + + if (destiny.NE.100+mappe) goto 561 + destiny = code_ok + reachedEndOfMap = .false. + + +c die DEBUG-Daten ausgeben: + + if (Debug .AND. start_Nr.LE.DEBUG_Anzahl) then + Debug_ = .true. + write(lunLOG,'(x,A,I4)') 'Teilchen Nr.',start_nr + call Output_Debug + else + Debug_ = .false. + endif + + +c Graphikausgabe beruecksichtigen: + + if (graphics .AND. start_Nr.LE.graphics_Anzahl) then + graphics_ = .true. + nKoord = 0 ! Koordinatenzaehler resetten + call Save_Graphics_Koord + else + graphics_ = .false. + endif + + +c Falls Koordinaten im NTupel verlangt sind: Speicher resetten und Startkoordinaten +c sichern: +c +c if (NTP_Koord) then +c do k = 0, Gebiete_Anzahl ! Trajektorienspeicher resetten +c do i = 1, 8 ! (1 bis 8: x,y,z,t,vx,vy,vz,E) +c Koord_NTP(i,k) = 0 +c enddo +c enddo +c call Save_NTP_Koord +c endif + + +c............................................................................... +c Integration: +c Im Bereich des Folienrandes ist es wegen der teilweise extremen +c Potentialverhaeltnisse kaum moeglich, eine etwas restriktivere Genauigkeits- +c forderung zu erfuellen. Daher wird im Fall von relativer Fehlerbetrachtung +c in diesem Bereich grundsaetzlich eine absolute Fehlerbetrachtung mit eps_x, +c eps_v = 1e-6 durchgefuehrt. +c (-> logical 'reducedAccur') + + do while (.NOT.reachedEndOfMap) + if (log_relativ.AND.x(1).LE.xMarke .AND. + + (Abs(x(2)).GE.yMarke .OR. abs(x(3)).GE.zMarke) ) then + reducedAccur = .true. + else + reducedAccur = .false. + endif + call INTEGRATIONSSTEP_RUNGE_KUTTA_1(dt) ! setzt u.U. 'destiny' + if (destiny.NE.code_ok) goto 551 + if (UseDecay_) call Decay_Test(*551) + + yAbs = abs(x(2)) + zAbs = abs(x(3)) + +c - Targethalter getroffen?: + if (x(1).LE.xEnd_TgtHolder .AND. (yAbs.GT.TgtConstY+x(1)*TgtFactorY + + .OR. zAbs.GT.TgtConstZ+x(1)*TgtFactorZ)) then + destiny = code_hit_TgtHolder + goto 551 + endif + + if (Steps.GE.MaxStep) then + destiny = code_lost + goto 551 + endif + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (GRAPHICS_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + enddo + + +c............................................................................... +551 continue + Gebiet = upToGrid1 + if (destiny.NE.code_ok) then + if (v(1).LE.0. .and. StartFlaeche.EQ.0) destiny = code_reflektiert + lastMap = mappe + if (debug_) then + if (destiny.LT.0) then + write(lunLog,4456) code_text(destiny) + else + write(lunLog,4456) code_text(destiny),Gebiet_text(Gebiet) + endif + endif + elseif (reachedEndOfMap) then + if (x(1).NE.xEndMap1) then + write(*,*)' %%%%% ACCEL: x(1).NE.xEndMap1: x(1) = ',x(1) + x(1) = xEndMap1 + endif + destiny = 100 + mappe+1 + calcMap(mappe+1) = .true. + else + write(*,*)' main: fatal error marker 1' + STOP + endif +4456 format(x,' >> ',A,:,T40,'(',A,')') + + +c schreibe die Trajektoriendaten fuer GRAPHICS weg: + + if (Graphics_) then + call Save_Graphics_Koord + call plot_trajectory + endif + + +c schreibe aktuelle Daten ins Zwischenspeicherungsfile: + +561 write(lunZwi(1-lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + + +c -> das naechste Projektil kann kommen: + + goto 11 + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der 2. Mappe (dx = 0.025 mm, dy = 0.025 mm, dz = 0.500 mm) +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +2 calcMap(2) = .false. + if (HVs_from_map) then + call read_map_2 + else + call add_map_2 + endif + start_Nr = 0 + + +c Zurueckspulen der Zwischenspeicherungsfiles: + + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien vorbereiten: + + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,2001)'map2: ',Uhrzeit,' %: 0' + else + write(*,*) 'integrating ...' + endif + + +c DEBUG beruecksichtigen: + + if (DEBUG) write (lunLOG,*) '>>>>>>> MAPPE 2 <<<<<<<' + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c hier starten die Projektile in die 2. Potentialmappe: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der aktuellen Trajektorienparameter: + +22 read(lunZwi(lunIndx),END=99999) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + if (UseDecay_) read(lunDecay) lifetime + start_nr = start_nr + 1 + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien: + + if (log_percent) then + if (100.*real(start_nr)/real(n_par(0)).GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,2002) percent_done + endif + endif + + +c beruecksichtige nur die Teilchen, die sich gerade in der aktuellen Mappe auf- +c halten: + + if (destiny.NE.100+mappe) goto 562 + destiny = code_ok + if (startFlaeche.EQ.1 .AND. steps.EQ.0 .AND. x(1).GE.xPosition_Grid1) then + alreadyTested = .true. + else + alreadyTested = .false. ! Gittertreffer noch zu pruefen + endif + reachedEndOfMap = .false. + backOneMap = .false. + + +c die DEBUG-Daten ausgeben: + + if (Debug .AND. start_Nr.LE.DEBUG_Anzahl) then + Debug_ = .true. + write(lunLOG,'(x,A,I4)') 'Teilchen Nr.',start_nr + call Output_Debug + else + Debug_ = .false. + endif + + +c Graphikausgabe beruecksichtigen: + + if (graphics .AND. start_Nr.LE.graphics_Anzahl) then + graphics_ = .true. + nKoord = 0 + call Save_Graphics_Koord + else + graphics_ = .false. + endif + + +c............................................................................... +c Integration: + + do while (.NOT.(backOneMap.OR.reachedEndOfMap)) + call INTEGRATIONSSTEP_RUNGE_KUTTA_2(dt) + if (destiny.NE.code_ok) goto 552 + if (UseDecay_) call Decay_Test(*552) + + yAbs = abs(x(2)) + zAbs = abs(x(3)) + +c - wires of first grid: auf 2 Methoden testen: +c 1.: liegt aktueller Raumpunkt innerhalb eines Gitterstabes? +c 2.: Falls gerade die Position des Drahtgitters passiert wurde: schneidet die +c aktuelle Bahntangente die Oberflaeche eines Gitterstabes? +c (Die 2. Methode wurde eingebaut, um speziell bei Rechnungen mir kleinerer +c Genauigkeit sicherzustellen, dass Drahttreffer moeglichst auch dann als +c solche erkannt werden, wenn die Schrittweite im Gitterbereich groesser +c als der Drahtdurchmesser sein sollte). + help1 = abs(x(1)-xPosition_Grid1) + if (help1.LE.rWires1 .AND. yAbs.LE.y_Pos_lastWire1+rWires1 .AND. + + zAbs.LE.innerDz_Gridframe1) then + ywire = nint((yAbs-y_Pos_firstWire1)/distance_wires1)*distance_wires1 + y_Pos_firstWire1 + if ( (help1*help1 + (yAbs-ywire)*(yAbs-ywire)) .LE. + + rQuadWires1) then + destiny = code_hit_grid1 + goto 552 + endif + endif +c Das jetzt folgende besser einmal aendern: +c Wenn entweder jetztige oder vorige Position oder beide im Bereich des Gitters +c sind: pruefe, ob Verbindungslinie der Punkte die Drahtoberflaeche schneidet. +c Auch Treffer der Rahmen etc ueber Schnitte mit den Verbindungslinien machen. +c (Dann wird ausgeschaltet, dass Teilchen von vor Hindernis bis hinter Hinderniss +c springt ohne dass Treffer bemerkt wird) + if (.NOT.alreadyTested .AND. x(1).GE.xPosition_Grid1 .AND. + + yAbs.LE.y_Pos_lastWire1+rWires1 .AND. zAbs.LE.innerDz_Gridframe1) then + ywire = nint((x(2)-y_Pos_firstWire1)/distance_wires1)*distance_wires1 + y_Pos_firstWire1 + distToWire(2) = x(2) - yWire + distToWire(1) = x(1) - xPosition_Grid1 + call Test_WireHit(distToWire,rQuadWires1,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_hit_grid1 + goto 552 + endif + alreadyTested = .true. + endif +c - Querbalken bei Gitter1: + if (x(1).GE.xStart_Balken .AND. x(1).LE.xEnd_Balken .AND. + + yAbs.LE.Dy_Balken .AND. + + zAbs.GE.innerDz_Balken .AND. zAbs.LE.outerDz_Balken) then + destiny = code_wand + goto 552 + endif +c - frame of first grid: + if (x(1).GE.xStart_Gridframe1 .AND. x(1).LE.xEnd_Gridframe1 .AND. + + (yAbs.GE.innerDy_Gridframe1 .OR. zAbs.GE.innerDz_Gridframe1) ) then + destiny = code_wand + goto 552 + endif + + if (Steps.GE.MaxStep) then + destiny = code_lost + goto 552 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + enddo + +c............................................................................... +552 continue + if (x(1).LT.xPosition_Grid1) then + Gebiet = upToGrid1 + else + Gebiet = upToGrid2 + endif + if (destiny.NE.code_ok) then + if (v(1).LE.0. .and. StartFlaeche.EQ.0) destiny = code_reflektiert + lastMap = mappe + if (debug_) then + if (destiny.LT.0) then + write(lunLog,4456) code_text(destiny) + else + write(lunLog,4456) code_text(destiny),Gebiet_text(Gebiet) + endif + endif + elseif (BackOneMap) then + if (x(1).NE.xStartMap2) then + write(*,*)' %%%%% ACCEL: x(1).NE.xStartMap2: x(1) = ',x(1) + x(1) = xStartMap2 + endif + destiny = 100 + mappe-1 + calcMap(mappe-1) = .true. + elseif (reachedEndOfMap) then + if (x(1).NE.xEndMap2) then + write(*,*)' %%%%% ACCEL: x(1).NE.xEndMap2: x(1) = ',x(1) + x(1) = xEndMap2 + endif + destiny = 100 + mappe+1 + calcMap(mappe+1) = .true. + else + write(*,*)' main: fatal error marker 2' + STOP + endif + + +c schreib die Trajektoriendaten fuer GRAPHICS weg: + + if (Graphics_) then + call Save_Graphics_Koord + call plot_trajectory + endif + + +c schreibe aktuelle Daten ins Zwischenspeicherungsfile: + +562 write(lunZwi(1-lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + + +c -> das naechste Projektil kann kommen: + + goto 22 + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der 3. Mappe (dx = 0.125mm, dy = 0.125mm, dz = 0.500 mm) +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +3 calcMap(3) = .false. + if (HVs_from_map) then + call read_map_3 + else + call add_map_3 + endif + start_Nr = 0 + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,2001)'map3: ',Uhrzeit,' %: 0' + else + write(*,*) 'integrating ...' + endif + if (DEBUG) write (lunLOG,*) '>>>>>>> MAPPE 3 <<<<<<<' +c............................................................................... +33 read(lunZwi(lunIndx),END=99999) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + if (UseDecay_) read(lunDecay) lifetime + start_nr = start_nr + 1 + if (log_percent) then + if (100.*real(start_nr)/real(n_par(0)).GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,2002) percent_done + endif + endif + if (destiny.NE.100+mappe) goto 563 + destiny = code_ok + reachedEndOfMap = .false. + backOneMap = .false. + if (Debug .AND. start_Nr.LE.DEBUG_Anzahl) then + Debug_ = .true. + write(lunLOG,'(x,A,I4)') 'Teilchen Nr.',start_nr + call Output_Debug + else + Debug_ = .false. + endif + if (graphics .AND. start_Nr.LE.graphics_Anzahl) then + graphics_ = .true. + nKoord = 0 + call save_graphics_Koord + else + graphics_ = .false. + endif +c............................................................................... + do while (.NOT.(backOneMap.OR.reachedEndOfMap)) + call INTEGRATIONSSTEP_RUNGE_KUTTA_3(dt) +cd write(lunLog,*)'t,x,v = ',t,x,v + if (destiny.NE.code_ok) goto 553 + if (UseDecay_) call Decay_Test(*553) + + yAbs = abs(x(2)) + zAbs = abs(x(3)) +c - frame of first grid: + if (x(1).GE.xStart_Gridframe1 .AND. x(1).LE.xEnd_Gridframe1 .AND. + + (yAbs.GE.innerDy_Gridframe1 .OR. zAbs.GE.innerDz_Gridframe1) ) then + destiny = code_wand + goto 553 + endif + + if (Steps.GE.MaxStep) then + destiny = code_lost + goto 553 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + enddo +c............................................................................... +553 continue + Gebiet = upToGrid2 + if (destiny.NE.code_ok) then + if (v(1).LE.0. .and. StartFlaeche.EQ.0) destiny = code_reflektiert + lastMap = mappe + if (debug_) then + if (destiny.LT.0) then + write(lunLog,4456) code_text(destiny) + else + write(lunLog,4456) code_text(destiny),Gebiet_text(Gebiet) + endif + endif + elseif (BackOneMap) then + if (x(1).NE.xStartMap3) then + write(*,*)' %%%%% ACCEL: x(1).NE.xStartMap3: x(1) = ',x(1) + x(1) = xStartMap3 + endif + destiny = 100 + mappe-1 + calcMap(mappe-1) = .true. + elseif (reachedEndOfMap) then + if (x(1).NE.xEndMap3) then + write(*,*)' %%%%% ACCEL: x(1).NE.xEndMap3: x(1) = ',x(1) + x(1) = xEndMap3 + endif + destiny = 100 + mappe+1 + calcMap(mappe+1) = .true. + else + write(*,*)' main: fatal error marker 3' + STOP + endif + if (Graphics_) then + call Save_Graphics_Koord + call plot_trajectory + endif +563 write(lunZwi(1-lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + goto 33 + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der 4. Mappe (dx = 0.050 mm, dy = 0.050 mm, dz = 0.500 mm) +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +4 calcMap(4) = .false. + if (HVs_from_map) then + call read_map_4 + else + call add_map_4 + endif + start_Nr = 0 + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,2001)'map4: ',Uhrzeit,' %: 0' + else + write(*,*) 'integrating ...' + endif + if (DEBUG) write (lunLOG,*) '>>>>>>> MAPPE 4 <<<<<<<' +c............................................................................... +44 read(lunZwi(lunIndx),END=99999) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + if (UseDecay_) read(lunDecay) lifetime + start_nr = start_nr + 1 + if (log_percent) then + if (100.*real(start_nr)/real(n_par(0)).GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,2002) percent_done + endif + endif + if (destiny.NE.100+mappe) goto 564 + destiny = code_ok + if (startFlaeche.EQ.2 .AND. steps.EQ.0 .AND. x(1).GE.xPosition_Grid2) then + alreadyTested = .true. + else + alreadyTested = .false. ! Gittertreffer noch zu pruefen + endif + reachedEndOfMap = .false. + backOneMap = .false. + if (Debug .AND. start_Nr.LE.DEBUG_Anzahl) then + Debug_ = .true. + write(lunLOG,'(x,A,I4)') 'Teilchen Nr.',start_nr + call Output_Debug + else + Debug_ = .false. + endif + if (graphics .AND. start_Nr.LE.graphics_Anzahl) then + graphics_ = .true. + nKoord = 0 + call save_graphics_Koord + else + graphics_ = .false. + endif +c............................................................................... + do while (.NOT.(backOneMap.OR.reachedEndOfMap)) + call INTEGRATIONSSTEP_RUNGE_KUTTA_4(dt) + if (destiny.NE.code_ok) goto 554 + if (UseDecay_) call Decay_Test(*554) + + yAbs = abs(x(2)) + zAbs = abs(x(3)) +c - wires of second grid: + help1 = abs(x(1)-xPosition_Grid2) + if (help1.LE.rWires2 .AND. yAbs.LE.y_Pos_lastWire2+rWires2 .AND. + + zAbs.LE.innerDz_Gridframe2) then + ywire = nint((yAbs-y_Pos_firstWire2)/distance_wires2)*distance_wires2 + y_Pos_firstWire2 + if ( (help1*help1 + (yAbs-ywire)*(yAbs-ywire)) .LE. + + rQuadWires2) then + destiny = code_hit_grid2 + goto 554 + endif + endif + if (.NOT.alreadyTested .AND. x(1).GE.xPosition_Grid2 .AND. + + yAbs.LE.y_Pos_lastWire2+rWires2 .AND. zAbs.LE.innerDz_Gridframe2) then + ywire = nint((x(2)-y_Pos_firstWire2)/distance_wires2)*distance_wires2 + y_Pos_firstWire2 + distToWire(2) = x(2) - yWire + distToWire(1) = x(1) - xPosition_Grid2 + call Test_WireHit(distToWire,rQuadWires2,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_hit_grid2 + goto 554 + endif + alreadyTested = .true. + endif +c - frame of second grid: + if (x(1).GE.xStart_Gridframe2 .AND. x(1).LE.xEnd_Gridframe2 .AND. + + (yAbs.GE.innerDy_Gridframe2 .OR. zAbs.GE.innerDz_Gridframe2) ) then + destiny = code_wand + goto 554 + endif + + if (Steps.GE.MaxStep) then + destiny = code_lost + goto 554 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + enddo +c............................................................................... +554 continue + if (x(1).LT.xPosition_Grid2) then + Gebiet = upToGrid2 + else + Gebiet = upToHeShield + endif + if (destiny.NE.code_ok) then + if (v(1).LE.0. .and. StartFlaeche.EQ.0) destiny = code_reflektiert + lastMap = mappe + if (debug_) then + if (destiny.LT.0) then + write(lunLog,4456) code_text(destiny) + else + write(lunLog,4456) code_text(destiny),Gebiet_text(Gebiet) + endif + endif + elseif (BackOneMap) then + if (x(1).NE.xStartMap4) then + write(*,*)' %%%%% ACCEL: x(1).NE.xStartMap4: x(1) = ',x(1) + x(1) = xStartMap4 + endif + destiny = 100 + mappe-1 + calcMap(mappe-1) = .true. + elseif (reachedEndOfMap) then + if (x(1).NE.xEndMap4) then + write(*,*)' %%%%% ACCEL: x(1).NE.xEndMap4: x(1) = ',x(1) + x(1) = xEndMap4 + endif + destiny = 100 + mappe+1 + calcMap(mappe+1) = .true. + else + write(*,*)' main: fatal error marker 4' + STOP + endif + if (Graphics_) then + call Save_Graphics_Koord + call plot_trajectory + endif +564 write(lunZwi(1-lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + goto 44 + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der 5. Mappe (dx = 0.125 mm, dy = 0.125 mm, dz = 0.500 mm) +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +5 calcMap(5) = .false. + if (HVs_from_map) then + call read_map_5 + else + call add_map_5 + endif + start_Nr = 0 + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,2001)'map5: ',Uhrzeit,' %: 0' + else + write(*,*) 'integrating ...' + endif + if (DEBUG) write (lunLOG,*) '>>>>>>> MAPPE 5 <<<<<<<' +c............................................................................... +55 read(lunZwi(lunIndx),END=99999) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + if (UseDecay_) read(lunDecay) lifetime + start_nr = start_nr + 1 + if (log_percent) then + if (100.*real(start_nr)/real(n_par(0)).GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,2002) percent_done + endif + endif + if (destiny.NE.100+mappe) goto 565 + destiny = code_ok + reachedEndOfMap = .false. + backOneMap = .false. + if (Debug .AND. start_Nr.LE.DEBUG_Anzahl) then + Debug_ = .true. + write(lunLOG,'(x,A,I4)') 'Teilchen Nr.',start_nr + call Output_Debug + else + Debug_ = .false. + endif + if (graphics .AND. start_Nr.LE.graphics_Anzahl) then + graphics_ = .true. + nKoord = 0 + call save_graphics_Koord + else + graphics_ = .false. + endif +c............................................................................... + do while (.NOT.(backOneMap.OR.reachedEndOfMap)) + call INTEGRATIONSSTEP_RUNGE_KUTTA_5(dt) + if (Steps.GE.MaxStep) destiny = code_lost + if (destiny.NE.code_ok) goto 555 + if (UseDecay_) call Decay_Test(*555) + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + enddo +c............................................................................... +555 continue + Gebiet = upToHeShield + if (destiny.NE.code_ok) then + if (v(1).LE.0. .and. StartFlaeche.EQ.0) destiny = code_reflektiert + lastMap = mappe + if (debug_) then + if (destiny.LT.0) then + write(lunLog,4456) code_text(destiny) + else + write(lunLog,4456) code_text(destiny),Gebiet_text(Gebiet) + endif + endif + elseif (BackOneMap) then + if (x(1).NE.xStartMap5) then + write(*,*)' %%%%% ACCEL: x(1).NE.xStartMap5: x(1) = ',x(1) + x(1) = xStartMap5 + endif + destiny = 100 + mappe-1 + calcMap(mappe-1) = .true. + elseif (reachedEndOfMap) then + if (x(1).NE.xEndMap5) then + write(*,*)' %%%%% ACCEL: x(1).NE.xEndMap5: x(1) = ',x(1) + x(1) = xEndMap5 + endif + destiny = 100 + mappe+1 + calcMap(mappe+1) = .true. + else + write(*,*)' main: fatal error marker 5' + STOP + endif + if (Graphics_) then + call Save_Graphics_Koord + call plot_trajectory + endif +565 write(lunZwi(1-lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + goto 55 + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der 6. Mappe (dx = 0.250 mm, dy = 0.250 mm, dz = 0.500 mm) +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +6 calcMap(6) = .false. + if (HVs_from_map) then + call read_map_6 + else + call add_map_6 + endif + start_Nr = 0 + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,2001)'map6: ',Uhrzeit,' %: 0' + else + write(*,*) 'integrating ...' + endif + if (DEBUG) write (lunLOG,*) '>>>>>>> MAPPE 6 <<<<<<<' +c............................................................................... +66 read(lunZwi(lunIndx),END=99999) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + if (UseDecay_) read(lunDecay) lifetime + start_nr = start_nr + 1 + if (log_percent) then + if (100.*real(start_nr)/real(n_par(0)).GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,2002) percent_done + endif + endif + if (destiny.NE.100+mappe) goto 566 + destiny = code_ok + if (Debug .AND. start_Nr.LE.DEBUG_Anzahl) then + Debug_ = .true. + write(lunLOG,'(x,A,I4)') 'Teilchen Nr.',start_nr + call Output_Debug + else + Debug_ = .false. + endif + if (graphics .AND. start_Nr.LE.graphics_Anzahl) then + graphics_ = .true. + nKoord = 0 + call save_graphics_Koord + else + graphics_ = .false. + endif +c............................................................................... +67 continue + call INTEGRATIONSSTEP_RUNGE_KUTTA_6(dt) + if (destiny.NE.code_ok) goto 556 + if (UseDecay_) call Decay_Test(*556) + +c - He-Shield getroffen bzw. He-Fenster erreicht? + radiusQuad = x(1)*x(1) + x(2)*x(2) + if (radiusQuad.GE.rQuadHeShield) then ! aufgeschlagen? + help1 = v(1)*v(1)+v(2)*v(2) + help2 = 2*(x(1)*v(1)+x(2)*v(2)) + help3 = radiusQuad - rQuadHeShield + dt = (-help2+SQRT(help2*help2-4*help1*help3))/(2*help1) + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (abs(x(2)).GE.dy_HeWindow .OR. + + abs(x(3)).GE.dz_HeWindow) then + destiny = code_wand + endif + goto 556 + endif + + if (Steps.GE.MaxStep) then + destiny = code_lost + goto 556 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + goto 67 +c............................................................................... +556 continue + Gebiet = upToHeShield + if (v(1).LE.0. .and. StartFlaeche.EQ.0) destiny = code_reflektiert +c if (v(1).LE.0.) destiny = code_reflektiert + lastMap = mappe + if (debug_) then + if (destiny.LE.0) then + write(lunLog,4456) code_text(destiny) + else + write(lunLog,4456) code_text(destiny),Gebiet_text(Gebiet) + endif + endif + if (Graphics_) then + call Save_Graphics_Koord + call plot_trajectory + endif +566 write(lunZwi(1-lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + goto 66 + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c Dieser Teil des Programmes bestimmt, in welcher Mappe jeweils weitergerechnet +c werden soll: +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +99999 continue + +c Vertauschen der Indizierung fuer zu lesendes und zu schreibendes Zwischen- +c speicherungsfile (0->1, 1->0): + + lunIndx = 1-lunIndx + + +c Falls immer noch Teilchen unterwegs sind, bestimme naechste abzuarbeitende +c Mappe und fahre fort zu integrieren: + + do mappe = 1,6 + if (calcMap(mappe)) goto (1,2,3,4,5,6) mappe + enddo + + +c falls nein: + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER IST DER PROGRAMMKODE FUER DIE INTEGRATION DER TRAJEKTORIEN +c BEENDET! -> SCHREIBE NTUPEL UND ACCEL-FILE: +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + rewind (lunStart) ! fuer Ausgabe in .ACCEL-file + rewind (lunZwi1) + rewind (lunZwi2) + if (UseDecay_) rewind (lunDecay) + + do start_nr = 1, n_par(0) + +c lies Daten ein: + + if (UseDecay_) read(lunDecay) lifetime + read(lunZwi(lunIndx)) steps,t,x,v,destiny,zaehler,n_dtsmall,Gebiet,lastMap,dt + + +c fuer NTupel- und Graphikausgabe: falls das Teilchen noch lebt, interpoliere +c die Trajektorie bis x = 40 mm (eventuelle Treffer des LN-Schildes bleiben +c dabei unberuecksichtigt!): + + if (destiny.EQ.code_ok) then + gebiet = upToLnShield + dt = ( 40-x(1) ) / v(1) + t40 = t + dt + x40(2) = x(2) + v(2)*dt + x40(3) = x(3) + v(3)*dt + endif + + +c Schreibe das Integrationsergebnis ins .ACCEL-file: + + if (NTP_stop) Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + read (lunStart) x0,v0,E0,theta0,phi0 + if (scaleFactor.EQ.1) then + call HFNT(idNTP) + else + ! Ort und Zeit muessen entsprechend skaliert werden: + t = t * scaleFactor + x(1) = x(1) * scaleFactor + x(2) = x(2) * scaleFactor + x(3) = x(3) * scaleFactor + call HFNT(idNTP) + ! skaliere fuer Plot bzw. Debug-Zwecke wieder zurueck: + t = t / scaleFactor + x(1) = x(1) / scaleFactor + x(2) = x(2) / scaleFactor + x(3) = x(3) / scaleFactor + endif + + +c Plotte letztes Teilstueck der Trajektorie: + + if (destiny.EQ.code_ok .AND. Graphics .AND. + + start_Nr.LE.graphics_Anzahl) then + x(1) = 40 + x(2) = x40(2) + x(3) = x40(3) + t = t40 + nKoord = 0 + call save_graphics_Koord + call Save_Graphics_Koord + call plot_trajectory + endif + + +c gib die Debug-Information aus: + + if (debug_) call Output_Debug + + +c Zaehle mit, bei wie vielen Teilchen trotz dtMaxStep abgebrochen werden: + + if (destiny.EQ.code_lost) lost_counter = lost_counter + 1 + + +c Zaehle zustaendigen 'destiny'-scaler hoch: + + if (destiny.GT.0) destiny = destiny + (Gebiet-1)*highest_code_Nr + statDestiny(destiny) = statDestiny(destiny) + 1 + + if (destiny.EQ.code_ok) okStepsCounter = okStepsCounter + steps + + enddo + + +c Schliesse die noch offenen und nicht mehr benoetigten files: + + close (lunZwi1) + close (lunZwi2) + close (lunStart) + if (UseDecay_) close (lunDecay) + + +c Mittlere Anzahl an Integrationsschritten fuer Trajektorien mit destiny=0 +c ausgeben: + + if (statDestiny(code_ok).NE.0) then + write(*,'(xA,F7.2)')'Mittlere Anzahl an Integrationsschritten bis zum Ziel: ', + + real(okStepsCounter)/real(statDestiny(code_ok)) + endif + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c ES FOLGEN SCHREIBEN DES LOGFILES, ERSTELLEN DES POSTSKRIPTS +C UND SPRUNG IN NEUE SCHLEIFE BZW. PROGRAMMENDE +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + +c das Summary ausgeben und die Werte in die Tabellen schreiben: +c Falls nur ein Teilchenstart pro Schleife erfolgt, werte die Statistiken +c erst nach der letzten Schleife aus. + + NotLastLoop = .NOT.(SchleifenNr.EQ.SchleifenZahl) + flag_ok = .NOT.(OneStartPerLoop.AND.NotLastLoop) + + if (flag_ok) then + call eval_statistics + if (n_outWhere.GT.0 .OR. smallLogFile) call Summary + if (createTabellen .or. createPhysTab) call output_tabellen + endif + + +c das PostScript-file erstellen: + +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Das Postskript braucht dann also erst bei der letzten Schleife +c erstellt zu werden: + + if (GRAPHICS .AND. flag_ok) then +c call schnitt_plot ! Ausgabe der Graphik der Schnittebene + + if (n_postSkript.LE.0) then + goto 396 + elseif (n_postSkript.EQ.1) then + if (n_outWhere.LT.2) then + write(*,*)'.....................................'// + + '.........................................' + write(*,'(2X,A18,I3,A,I3)')'Schleife ', + + SchleifenNr,' von ',SchleifenZahl + endif + write(*,394)'(P) Ps-file erstellen', + + '(R) Restliche ps-files erstellen' + write(*,394)'(N) ps-file Nicht erstellen', + + '(K) Keine ps-files mehr erstellen' + write(*,394)'(G) Graphikausgabe beenden', + + '(A) programm Abbrechen' +394 format(T6,A,T40,A) + +27 write(*,395)' [RETURN] = (N) -> ' +395 format($,x,A) + read(*,'(A)') helpChar + +28 do i = 1,7 ! bis zu sechs blanks werden akzeptiert + ant = helpChar(i:i) + if (ant.NE.' ') goto 29 + enddo + ant = 'n' + +29 write(*,*)'==========================='// + + '=====================================================' + + if (ant.EQ.'n' .OR. ant.EQ.'N') then + goto 396 + elseif (ant.EQ.'r' .OR. ant.EQ.'R') then + n_postSkript = 2 + elseif (ant.EQ.'k' .OR. ant.EQ.'K') then + n_postSkript = 0 + goto 396 + elseif (ant.EQ.'g' .OR. ant.EQ.'G') then + call HPLEND + GRAPHICS = .false. + goto 200 + elseif (ant.EQ.'a' .OR. ant.EQ.'A') then + call HPLEND + call TERMINATE_OUTPUT + STOP + elseif (ant.NE.'p' .AND. ant.NE.'P') then + goto 27 + endif + endif + + write (helpChar(1:7),'(''_'',I6)') SchleifenNr + if (filename.NE.' ') then + call MAKE_PS(filename//helpChar) + else + call MAKE_PS('ACCEL'//helpChar) + endif + + +396 continue + + CALL IZPICT ('CHAMBER','S') ! LOESCHEN DER BILDER IM PAWC-COMMON-BLOCK + CALL IZPICT ('HISTO','S') + CALL IZPICT ('TEXT','S') + + call iclrwk (1,0) ! CLEAREN DER PAW-'WORKSTATIONS' + call iclrwk (4,0) + call iclrwk (5,0) + + CALL HRESET (50,' ') ! RESETTEN DES HISTOGRAMMS + + endif + +c -> das gleiche von vorne mit neuen Settings (d.h. neue Schleife) + +200 continue +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Jetzt sind alle Schleifen abgearbeitet -> fertigmachen zum Programmende: + + if (Graphics) call HPLEND ! Beende HIGZ Graphikbibliothek + + call TERMINATE_OUTPUT + + + END + + +C=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Lambert_Verteilung(n_Lambert,cos_theta,sin_theta) +c ============================================================ + + IMPLICIT NONE + + real cos_theta,sin_theta + + real n_Lambert ! Ordnung der Lambert-Verteilung + real dummy + integer seed + common /seed/ seed + + dummy = ran(seed) + + if (n_Lambert.EQ.0.) then + cos_theta = (1.-dummy) + sin_theta = sqrt(1.-cos_theta*cos_theta) + elseif (n_Lambert.EQ.1.) then + cos_theta = sqrt(1.-dummy) + sin_theta = sqrt(dummy) + else + cos_theta = (1.-dummy)**(1./(n_Lambert + 1)) + sin_theta = sqrt(1.-cos_theta*cos_theta) + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung(sigma,wert) +c ======================================= + + IMPLICIT NONE + + real sigma ! Breite der Gaussverteilung + real wert ! gewuerfelte Returnvariable + real radius,phi + + integer seed + common /seed/ seed + +c Da die eindimensionale Gaussfunktion nicht integrierbar ist, wird erst +c ein Punkt in der Ebene mit der entsprechenden zweidimensionalen Gaussfunktion +c gewuerfelt. Von diesem Punkt wird dann die x-Komponente zurueckgegeben, die +c eindimensional Gaussverteilt ist: + + radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = 360.*ran(seed) + wert = radius * cosd(phi) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung_theta(sigma,theta) +c ============================================== + + IMPLICIT NONE + + real sigma,theta + real radius,phi,ratio + + integer i, seed + common /seed/ seed + +c Man beachte, dass hier Winkel gewuerfelt werden! D.h., dass die Variable +c 'radius' einen Radius in einer 2dimensionalen 'Winkel'-Ebene darstellt. +c Es wird angenommen, dass sigma in degree angegeben wird (daher die sind()- +c Funktion in der Zuweisung fuer 'ratio' anstelle der sin()-Fkt.). + + i = 1 + +10 radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = 360.*ran(seed) + theta = abs(radius * cosd(phi)) + ! nur theta zwischen 0 und 90 deg sollen eine Chance haben: + if (theta.GT.90) then + i = i + 1 + if (i.LE.10000) then + goto 10 + else + write(*,*) + write(*,*) 'SUBROUTINE Gauss_Verteilung_theta:' + write(*,*) ' Nach 10000 Versuchen noch keinen Winkel < 90 degree gewuerfelt.' + write(*,*) ' Vorgegebenes Sigma der Winkelverteilung: ',sigma + write(*,*) + STOP + endif + endif + +c Zitat aus TP's 'TESTSEED.FOR', aus welchem diese Routine abgeschrieben +c ist: +c +c Now we habe a GAUSSIAN, but we need for multiple scattering +c GAUSSIAN*SIN(x) =: g(x). This is not integrateable analytically, but +c we can choose the VON NEUMANN REJECTION to get what we want. +c As auxiliary function we choose the GAUSSIAN =: f(x), because it +c satisfies g(x) <= f(x) for all x. +c We must build the ratio g(x)/f(x) = sin(x) and compare it to +c another random number: + + ratio = sind(theta) + if (ran(seed).GT.ratio) goto 10 ! Verteilung zurechtbiegen + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE reset_statistics +c =========================== + + IMPLICIT NONE + + integer Nr,k + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c der allgemeine Statistikspeicher: (*) : braucht nicht resettet zu werden +c --------------------------------- +c +c statMem(1,Nr): 1. Wert: x(1) (*) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ergebnis-Statistik-Speicher resetten: + + do Nr = 1, stat_Anzahl + statMem(2,Nr) = 0. ! Summe der Werte + statMem(3,Nr) = 0. ! Summe der Quadrate + statMem(4,Nr) = 1.e10 ! Minimalwert + statMem(5,Nr) = -1.e10 ! Maximalwert + statMem(8,Nr) = 0. ! Anzahl + enddo + + +c StartZaehler resetten: + + start_nr = 0 + + +c der Statistikspeicher fuer das Teilchen-Schicksal: + + do k = smallest_code_Nr, Gebiete_Anzahl*highest_code_Nr + statDestiny(k) = 0 + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE fill_statMem(wert,Nr) +c ================================ + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + real wert + integer Nr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Wird die Varianz der Verteilung einer Groesse x gemaess der Formel +c +c Var(x) = SQRT( - **2 ) , < > -> Erwartungswert +c +c mit +c = 1/n * Summe_ueber_i( x(i) ) +c = 1/n * Summe_ueber_i( x(i)**2 ) +c +c berechnet, so tritt manchmal aufgrund der beschraenkten Genauigkeit der +c numerischen Speicher das Problem auf, dass bei grossen Werten x(i) und +c kleiner Streuung der Ausdruck unter der Wurzel negativ wird, was erstens +c unphysikalisch ist und zweitens zum Programmabbruch fuehrt. +c +c Dieses Problem liesse sich vermeiden, wenn man die Groessen x(i) relativ +c zu ihrem Erwartungswert angeben wuerde, der aber erst im nachhinein bekannt +c ist. +c +c Als Naeherungsloesung verwende ich daher fuer die Berechnung der Varianz die +c x(i) relativ zu x(1), also zum ersten Wert gemessen, der gerade bei kleiner +c Streuung, bei der das numerische Problem auftritt, nahe am Erwartungswert +c liegen sollte. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c 1. Zaehle mit. +c 2. Speichere den ersten Wert. +c 3. Summiere die Abweichungen vom ersten Wert: +c 4. Summiere die Quadratischen Abweichungen vom ersten Wert: +c 5. Speichere den kleinsten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(4,Nr) = 1.e10): +c 6. Speichere den groessten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(5,Nr) = -1.e10): + + statMem(8,Nr) = statMem(8,Nr) + 1. ! 1. + if (statMem(8,Nr).EQ.1) statMem(1,Nr) = wert ! 2. + statMem(2,Nr) = statMem(2,Nr) + (wert-statMem(1,Nr)) ! 3. + statMem(3,Nr) = statMem(3,Nr) + (wert-statMem(1,Nr))**2. ! 4. + if (statMem(4,Nr).GT.wert) statMem(4,Nr) = wert ! 5. + if (statMem(5,Nr).LT.wert) statMem(5,Nr) = wert ! 6. + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE eval_statistics +c ========================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + real n ! Anzahl der Werte, == statMem(8,Nr) + real radiant + + integer Nr + + do Nr = 1, Stat_Anzahl + if (statNeeded(Nr)) then + n = statMem(8,Nr) + if (n.ne.0.) then + ! Berechne Mittelwert: + statMem(6,Nr) = statMem(2,Nr)/n + statMem(1,Nr) + ! Berechne Varianz: + radiant = ( statMem(3,Nr) - (statMem(2,Nr)**2. )/n)/n + statMem(7,Nr) = sqrt(radiant) + ! Berechne Anteil an allen Gestarteten in Prozent: + statMem(9,Nr) = 100.*n/real(n_par(0)) + endif + endif + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SAVE_NTP_KOORD +c ========================= + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + real Ekin + + Ekin = (v(1)*v(1) + v(2)*v(2) + v(3)*v(3)) * Energie_Faktor + + Koord_NTP(1,Gebiet) = x(1) + Koord_NTP(2,Gebiet) = x(2) + Koord_NTP(3,Gebiet) = x(3) + + Koord_NTP(4,Gebiet) = t + + Koord_NTP(5,Gebiet) = v(1) + Koord_NTP(6,Gebiet) = v(2) + Koord_NTP(7,Gebiet) = v(3) + + Koord_NTP(8,Gebiet) = Ekin + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SAVE_GRAPHICS_KOORD +c ============================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000) ! Koordinatenfelder fuer die + real yKoord(1000) ! Graphikausgabe + real zKoord(1000) ! + integer nKoord ! Anzahl der Koordinaten + +c dieser Commonblock ist auch im Hauptprogramm sowie in den Routinen der Datei +c 'SUB_MUPIC.FOR' definiert + + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord ! fuer Graphikaufruf + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + nKoord = nKoord + 1 + + xKoord(nKoord) = x(1)*scaleFactor + yKoord(nKoord) = x(2)*scaleFactor + zKoord(nKoord) = x(3)*scaleFactor + + if (nKoord.EQ.1000) then + call plot_trajectory + xKoord(1) = xKoord(1000) + yKoord(1) = yKoord(1000) + zKoord(1) = zKoord(1000) + nKoord = 1 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Output_Debug +c ======================= + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_GEO.INC' + + + real Ekin + integer iostat + + Ekin = (v(1)*v(1) + v(2)*v(2) + v(3)*v(3)) * Energie_Faktor + write(lun(1),1,iostat=iostat) steps,t,x,v,Ekin + +1 format(X,I4,7X,F6.1,2X,F7.2,X,F6.2,X,F6.2,2X,F6.2,X, + + F6.2,X,F6.2,2X,G13.6) + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Decay_Test(*) +c ======================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + real dt + + if (scaleFactor*t.GT.lifeTime) then ! Teilchen zerfallen + dt = t - lifeTime/scaleFactor + t = lifeTime/scaleFactor + x(1) = x(1) - dt*v(1) + x(2) = x(2) - dt*v(2) + x(3) = x(3) - dt*v(3) + destiny = code_decay + RETURN 1 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE test_wireHit(distToWire,WireRadiusQuad,v_x,v_y,WireHit) +c ================================================================== + +c Diese Routine ueberprueft, ob bei gegebenem Abstandsvektor 'distToWire' +c zwischen Drahtposition und Teilchenort und gegebener Geschwindigkeit v eines +c Teilchens bei geradliniger Bewegung der Draht mit Radius WireRadius getroffen +c wird. + + IMPLICIT NONE + + real DistToWire(2),WireRadiusQuad,v_x,v_y + logical WireHit + + real steigung, help, radiant + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (v_x.GT.v_y) then + steigung = v_y/v_x + help = distToWire(2) - distToWire(1) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + else + steigung = v_x/v_y + help = distToWire(1) - distToWire(2) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + endif + + if (radiant.ge.0) then + wireHit = .true. + else + wireHit = .false. + endif + + + END + + +c=============================================================================== diff --git a/accel/src/ADD_MAP.INC b/accel/src/ADD_MAP.INC new file mode 100644 index 0000000..800fbb3 --- /dev/null +++ b/accel/src/ADD_MAP.INC @@ -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 + diff --git a/accel/src/CALC_FIELD_1.INC b/accel/src/CALC_FIELD_1.INC new file mode 100644 index 0000000..e7615f4 --- /dev/null +++ b/accel/src/CALC_FIELD_1.INC @@ -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 + + diff --git a/accel/src/CALC_FIELD_2.INC b/accel/src/CALC_FIELD_2.INC new file mode 100644 index 0000000..a98482c --- /dev/null +++ b/accel/src/CALC_FIELD_2.INC @@ -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 + diff --git a/accel/src/CODENUMMERN.LIST b/accel/src/CODENUMMERN.LIST new file mode 100644 index 0000000..5ea3681 --- /dev/null +++ b/accel/src/CODENUMMERN.LIST @@ -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 + + =============================================================================== diff --git a/accel/src/COM_ACCEL.INC b/accel/src/COM_ACCEL.INC new file mode 100644 index 0000000..c9ccd9b --- /dev/null +++ b/accel/src/COM_ACCEL.INC @@ -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 + diff --git a/accel/src/COM_BS.INC b/accel/src/COM_BS.INC new file mode 100644 index 0000000..828e1ed --- /dev/null +++ b/accel/src/COM_BS.INC @@ -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 + diff --git a/accel/src/COM_DIRS.INC b/accel/src/COM_DIRS.INC new file mode 100644 index 0000000..2ac5c13 --- /dev/null +++ b/accel/src/COM_DIRS.INC @@ -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' ) + diff --git a/accel/src/COM_GEO.INC b/accel/src/COM_GEO.INC new file mode 100644 index 0000000..22142c5 --- /dev/null +++ b/accel/src/COM_GEO.INC @@ -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 + diff --git a/accel/src/COM_HVS.INC b/accel/src/COM_HVS.INC new file mode 100644 index 0000000..b3c9f6e --- /dev/null +++ b/accel/src/COM_HVS.INC @@ -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 + + diff --git a/accel/src/INITIALIZE.INC b/accel/src/INITIALIZE.INC new file mode 100644 index 0000000..26efc55 --- /dev/null +++ b/accel/src/INITIALIZE.INC @@ -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 + + diff --git a/accel/src/MAPMAP.INC b/accel/src/MAPMAP.INC new file mode 100644 index 0000000..5f815ee --- /dev/null +++ b/accel/src/MAPMAP.INC @@ -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 + diff --git a/accel/src/MAP_DEF_1.INC b/accel/src/MAP_DEF_1.INC new file mode 100644 index 0000000..b80f0dd --- /dev/null +++ b/accel/src/MAP_DEF_1.INC @@ -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' + diff --git a/accel/src/MAP_DEF_2.INC b/accel/src/MAP_DEF_2.INC new file mode 100644 index 0000000..75fdad8 --- /dev/null +++ b/accel/src/MAP_DEF_2.INC @@ -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' + diff --git a/accel/src/MAP_DEF_3.INC b/accel/src/MAP_DEF_3.INC new file mode 100644 index 0000000..b378d09 --- /dev/null +++ b/accel/src/MAP_DEF_3.INC @@ -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' + diff --git a/accel/src/MAP_DEF_4.INC b/accel/src/MAP_DEF_4.INC new file mode 100644 index 0000000..524369e --- /dev/null +++ b/accel/src/MAP_DEF_4.INC @@ -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' + diff --git a/accel/src/MAP_DEF_5.INC b/accel/src/MAP_DEF_5.INC new file mode 100644 index 0000000..36be54a --- /dev/null +++ b/accel/src/MAP_DEF_5.INC @@ -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' + diff --git a/accel/src/MAP_DEF_6.INC b/accel/src/MAP_DEF_6.INC new file mode 100644 index 0000000..8d8a850 --- /dev/null +++ b/accel/src/MAP_DEF_6.INC @@ -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' + diff --git a/accel/src/READ_INFO.INC b/accel/src/READ_INFO.INC new file mode 100644 index 0000000..94e8a72 --- /dev/null +++ b/accel/src/READ_INFO.INC @@ -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 + diff --git a/accel/src/READ_MAP.INC b/accel/src/READ_MAP.INC new file mode 100644 index 0000000..abed4f9 --- /dev/null +++ b/accel/src/READ_MAP.INC @@ -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 + diff --git a/accel/src/RUNGE_KUTTA.INC b/accel/src/RUNGE_KUTTA.INC new file mode 100644 index 0000000..34afde9 --- /dev/null +++ b/accel/src/RUNGE_KUTTA.INC @@ -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 + + diff --git a/accel/src/SUB_ARTLIST.FOR b/accel/src/SUB_ARTLIST.FOR new file mode 100644 index 0000000..31fb5fd --- /dev/null +++ b/accel/src/SUB_ARTLIST.FOR @@ -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=============================================================================== diff --git a/accel/src/SUB_INPUT.FOR b/accel/src/SUB_INPUT.FOR new file mode 100644 index 0000000..b18aa90 --- /dev/null +++ b/accel/src/SUB_INPUT.FOR @@ -0,0 +1,1020 @@ + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE read_inputFile +c ========================= + + IMPLICIT NONE + +c Diese Subroutine liest das Eingabe-file 'ACCEL.INPUT' und stellt +c die Simulationsparameter fuer das Programm entsprechend ein. Die Parameter +c befinden sich alle in einem COMMON-Block und stehen so im gesamten Programm +c zur Verfuegung. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c name-list: + + namelist /parameter_liste/ + + + TestRun, mappenName, dy_HeWindow,dz_HeWindow, + + Startflaeche,x0_, + + randomStarts, random_energy,lowerE0,upperE0,sigmaE0,adjustSigmaE0, + + random_position,StartBreite,StartHoehe,StartRadius,sigmaPosition, + + random_winkel,StartLambertOrd,SigmaWinkel, + + + Masse_,Ladung_, U_Tgt_,U_Gua_,U_G1_, B_Helm_,B_TD_, + + E0_,y0_,z0_,theta0_,phi0_, E0InterFromFile, + + + artList, UseDecay, DEBUG, DEBUG_Anzahl, + + + GRAPHICS, GRAPHICS_Anzahl, n_postSkript, iMonitor, n_outWhere, + + + createPhysTab, NTP_start,NTP_stop,NTP_40mm, + + + eps_x,eps_v,log_relativ, maxStep, dtsmall, maxBelowDtSmall, log_confine, + + + scaleFactor + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + INCLUDE 'accel$sourcedirectory:COM_GEO.INC' + + character*40 inputName /'ACCEL.INPUT'/ + COMMON /inputName/ inputName + + integer k ! Zaehlvariable + logical flag + logical flag_message /.false./ + real help + integer ihelp + character antwort*5 + + real x0_ / 0. / ! StartKoordinate + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Variablen im Zusammenhang mit den Eingabefile-Listen 'LISTn.INPUT': + + integer lastOne /0/, fileNr, iostat, length + logical testRun_ + character datum*9,uhrzeit*8 + + +c die Anzahl zufallsverteilter Starts: + + integer randomStarts / 50 / + + +c die lokalen Variablen fuer das Einlesen der Schleifenparameter, die dann +c in das Feld 'par' uebertragen werden: + + ! von ! bis ! step ! + real U_Tgt_(3) / 0. , +1.e10 , -1.e10 / + real U_Gua_(3) / 0. , +1.e10 , -1.e10 / + real U_G1_(3) / 0. , +1.e10 , -1.e10 / + + real B_Helm_(3) / 0. , +1.e10 , -1.e10 / + real B_TD_(3) / 0. , +1.e10 , -1.e10 / + + real Masse_(3) / 105659. , +1.e10 , -1.e10 / + real Ladung_(3) / 1. , +1.e10 , -1.e10 / + + real E0_(3) / 0. , +1.e10 , -1.e10 / + real y0_(3) / 0. , +1.e10 , -1.e10 / + real z0_(3) / 0. , +1.e10 , -1.e10 / + real theta0_(3) / 0. , +1.e10 , -1.e10 / + real phi0_(3) / 0. , +1.e10 , -1.e10 / + + + character*80 zeile + + +c die lokalen Variablen fuer das Einlesen der logicals fuer die Ausgabe der +c verschiedenen Statistiken im Log-file, die dann in das Feld 'statInSummary' +c uebertragen werden: + +c logical SUM_S1M2 / .false. / + + +c die lokalen Variablen fuer das Einlesen der logicals fuer die Erzeugung +c der Tabellen-files der verschiedenen Statistiken, die dann in das Feld +c 'createTabelle' uebertragen werden: + +c logical TAB_S1M2 / .false. / + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Variable fuer den Test, ob 'ACCEL' als batch job laeuft: +c (setzt voraus, dass im Falle eines batch jobs das logical +c 'running_in_batchmode' definiert ist). + + INCLUDE '($SSDEF)/NOLIST' + INCLUDE '($LNMDEF)/NOLIST' + + integer status, sys$trnlnm + + STRUCTURE /ITMLST/ + UNION + MAP + integer*2 BUFLEN + integer*2 CODE + integer*4 BUFADR + integer*4 RETLENADR + END MAP + MAP + integer*4 END_LIST + END MAP + END UNION + END STRUCTURE + + RECORD /ITMLST/ LNMLIST(2) + + character*20 running_in_batchmode + + +c=============================================================================== + + gotFileNr = .false. + +c Pruefe, ob ACCEL als batch job laeuft: + + LNMLIST(1).BufLen = Len(RUNNING_IN_BATCHMODE) + LNMLIST(1).Code = LNM$_STRING + LNMLIST(1).BufAdr = %Loc(RUNNING_IN_BATCHMODE) + LNMLIST(1).RetLenAdr = 0 + + Status = SYS$trnlnm(lnm$M_case_blind, + + 'lnm$file_dev','RUNNING_IN_BATCHMODE',,Lnmlist) + + if (Status.EQ.SS$_NOLOGNAM) then + batch_mode = .false. + INPUT_LIST = .false. + else + write(*,*) + write(*,*) ' >>>> *******************************************' + write(*,*) ' >>>>> logical ''RUNNING_IN_BATCHMODE'' is defined' + write(*,*) ' >>>>> => assume ACCEL is run in batch mode' + write(*,*) ' >>>> *******************************************' + write(*,*) + batch_mode = .true. + + +c Pruefe, of 'InputListName' definiert ist. Falls ja, verwende die entsprechende +c Eingabeliste. Ansonsten bearbeite ACCEL.INPUT: + + LNMLIST(1).BufLen = Len(inputListName) + LNMLIST(1).Code = LNM$_STRING + LNMLIST(1).BufAdr = %Loc(inputListName) + LNMLIST(1).RetLenAdr = 0 + + Status = SYS$trnlnm(lnm$M_case_blind, + + 'lnm$file_dev','inputListName',,Lnmlist) + + if (Status.NE.SS$_NOLOGNAM) then + call str$trim(inputListName,inputListName,Length) + inputListName = inputListName(1:length) + INPUT_LIST = .true. + endif + + +c Liess gegebenenfalls zu verwendenden Input-filenamen ein: + + if (INPUT_LIST) then + open(lunRead,file=inputListName//'.INPUT',status='old',iostat=iostat, + + defaultfile=readDir) + if (iostat.NE.0) then + write(*,*) ' Kann '''//inputListName//'.INPUT'' nicht oeffnen' + write(*,*) + call exit + endif + + ListLength = 0 + testRun_ = .false. +10 read(lunRead,'(A)',end=20) inputName + read(inputName,*,iostat=iostat) ihelp + if (iostat.NE.0) then + ListLength = ListLength + 1 + goto 10 + else + if (ihelp.GT.0) then + lastOne = ihelp + if (lastOne.EQ.1) then + write(*,*) 'Es wurden schon alle files aus '''//inputListName//'.INPUT''' + write(*,*) 'abgearbeitet!' + write(*,*) + close(lunRead) + call exit + endif + else + gotFileNr = .true. + fileNr = -ihelp+1 + if (fileNr.EQ.10000) fileNr=9900 + endif + goto 10 + endif + +20 if (listLength.EQ.0) then + write(*,*) ' no file names found in inputList -> STOP' + call exit + endif + if (lastOne.EQ.0) lastOne=listLength+1 + + +c den Namen des fuer diese Simulation zu verwendenden input-files einlesen: + + rewind(lunRead) + do k = 1, lastOne-2 + read(lunRead,*) + enddo + read(lunRead,'(A)') inputName + + +c die Nummer des jetzt verwendeten input-files sowie (falls schon bekannt) die +c (negative) fileNr der Ausgabefile ausgeben: + + ! bis Listenende weiterblaettern: + do k = lastOne, listLength + read(lunRead,*) + enddo + write(lunRead,*) lastOne-1 + if (gotFileNr) write(lunRead,*) -fileNr + close(lunRead) + + +c gegebenenfalls schon den Namen der Ausgabe-files definieren: + + if (gotFileNr) then + if (fileNr.GE.9900) then + TestRun_ = .true. + else + TestRun_ = .false. + endif + write(filename(4:7),'(I4)')fileNr + if (fileNr.LE.999) write (filename(4:4),'(A1)') '0' + if (fileNr.LE. 99) write (filename(5:5),'(A1)') '0' + if (fileNr.LE. 9) write (filename(6:6),'(A1)') '0' + endif + + + write(*,'(xA,I3,A)')'Verwende',listLength-lastOne+2, + + '.letzte INPUT-Datei aus '''//inputListName//'.INPUT'': ' + write(*,*) inputName + + open(lunMessage,file='AC_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + write(lunMessage,'(xx,I2)',iostat=iostat) lastOne-1 + + else + + open(lunMessage,file='ACCEL.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + + endif + + call date(datum) + call time(uhrzeit) + write(lunMessage,*,iostat=iostat) ' started on '//datum//' at '//uhrzeit + write(lunMessage,*,iostat=iostat) inputname + close(lunMessage,iostat=iostat) + + endif + + +c=============================================================================== + +c Einlesen der Eingabe-Datei: + + open(lunREAD,file=inputName,defaultfile=readDir//':.INPUT', + + status='OLD',readonly) + read(lunREAD,nml=parameter_liste) + close(lunREAD) + + +c Einlesen der 'overwrite_default'-Datei: + + open(lunREAD,file='overwrite_defaults',defaultfile=readDir//':.INPUT', + + status='OLD',readonly,iostat=iostat) + if (iostat.EQ.0) then + write(*,*) ' ##### READING INPUT FROM FILE >> ''OVERWRITE_DEFAULTS.INPUT'' << #####' + read(lunREAD,nml=parameter_liste) + close(lunREAD) + endif + write(*,*) + + if (E0InterFromFile) then + ! read E0-Intervalls from File E0-Intervalls.input: + open(lunREAD,file='E0-Intervalls',defaultfile=readDir//':.INPUT', + + status='OLD',readonly) + + nE0Inter = 0 +5 read(lunREAD,'(A)',iostat=iostat) zeile + if (ioStat.EQ.0) then + call str$upcase(zeile,zeile) + if (index(zeile,'XXXXXXXXX').NE.0) goto 6 + if (zeile.NE.' ' .AND. index(zeile,'*').EQ.0 .AND. + + index(zeile,'!').EQ.0 .AND. index(zeile,'C').EQ.0) then + nE0Inter = nE0Inter + 1 + if (nE0Inter.GT.101) then + write(*,*) 'you gave more than 100 E0 intervalls' + call exit + endif + read(zeile,*) E0Low(nE0Inter) + endif + goto 5 + endif + close(lunREAD) + +6 nE0Inter = nE0Inter - 1 + do k = 1, nE0Inter + write(*,'(x,A,I4,A,F6.3,A,F6.3,A)') 'E0-intervall',k,': [',E0Low(k),',',E0Low(k+1),']' + enddo + if (nE0Inter.LT.1) then + write(*,*) 'found no E0 intervalls in ''E0-INTERVALLS.INPUT''' + call exit + endif + E0_(1) = 1 + E0_(2) = nE0Inter + E0_(3) = 1 + random_energy = 1 + lowerE0 = E0Low(1) + upperE0 = E0Low(nE0Inter+1) + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Ueberpruefen und Auswerten der Parameter: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (mappenName.EQ.' ') then + write(*,*)' Potentialmappe nicht spezifiziert!' + write(*,*)' (Zuweisung fuer ''mappenName'' in ''ACCEL.INPUT'')' + write(*,*) + write(*,*)' -> STOP' + write(*,*) + STOP + elseif (mappenName.EQ.'2') then + mappenName = 'sep92_new' + elseif (mappenName.EQ.'3') then + mappenName = 'sep92_new' + elseif (mappenName.EQ.'4') then + mappenName = 'sep92_new' + elseif (mappenName.EQ.'5') then + mappenName = 'sep92_new' + elseif (mappenName.EQ.'6') then + mappenName = 'run6_new' + elseif (mappenName.EQ.'7') then + mappenName = 'run6_new' + elseif (mappenName.EQ.'8') then + mappenName = 'run6_new' + elseif (mappenName.EQ.'9') then + mappenName = 'run9' + elseif (mappenName.EQ.'10') then + mappenName = 'run10' + endif + + +c Entfernen von 'leading blanks' aus 'mappenName': + + indx1 = 1 +30 indx = index(mappenName,' ') + if (indx.EQ.indx1) then + mappenName(indx:indx) = '$' + indx1 = indx1+1 + goto 30 + endif + +c nimm 'mappenName' bis zum ersten blank oder bis zum Punkt: + + indx2 = indx + indx = index(mappenName,'.') + if (indx.NE.0) indx2 = min(indx2,indx) + indx2 = indx2-1 + + mappenName = mappenName(indx1:indx2) + nameLength = indx2-indx1+1 + + +c mache 'mappenName' uppercase: + + call str$upcase(mappenName,mappenName) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der Schleifenparameter in das Feld 'par': + + do k = 1,3 + + par(k,UTarget) = U_Tgt_ (k) + par(k,UGuard) = U_Gua_ (k) + par(k,UGi1) = U_G1_ (k) + + par(k,BHelm) = B_Helm_ (k) + par(k,BTD) = B_TD_ (k) + + par(k,mass) = Masse_ (k) + par(k,charge) = Ladung_ (k) + + par(k,ener) = E0_ (k) + par(k,yPos) = y0_ (k) + par(k,zPos) = z0_ (k) + par(k,thetAng) = theta0_ (k) + par(k,phiAng) = phi0_ (k) + + enddo + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen und Pruefen der zu den Potentialmappen gehoerenden INFO-files: + + call read_INFOS ! setzt gegebenenfalls das logical 'HVs_from_map' + ! und passt par(i,UTarget), par(i,UGuard) und + ! par(i,UGi1) an. + + +c Pruefe ob Potentialmappen aneinander stossen: + + if (xEndMap1.NE.xStartMap2) then + write(*,*)' End of map 1 misses start of map 2:' + write(*,*)' xEndMap1 = ',xEndMap1 + write(*,*)' xStartMap2 = ',xStartMap2 + write(*,*)' -> STOP' + STOP + elseif (xEndMap2.NE.xStartMap3) then + write(*,*)' End of map 2 misses start of map 3:' + write(*,*)' xEndMap2 = ',xEndMap2 + write(*,*)' xStartMap3 = ',xStartMap3 + write(*,*)' -> STOP' + STOP + elseif (xEndMap3.NE.xStartMap4) then + write(*,*)' End of map 3 misses start of map 4:' + write(*,*)' xEndMap3 = ',xEndMap3 + write(*,*)' xStartMap4 = ',xStartMap4 + write(*,*)' -> STOP' + STOP + elseif (xEndMap4.NE.xStartMap5) then + write(*,*)' End of map 4 misses start of map 5:' + write(*,*)' xEndMap4 = ',xEndMap4 + write(*,*)' xStartMap5 = ',xStartMap5 + write(*,*)' -> STOP' + STOP + elseif (xEndMap5.NE.xStartMap6) then + write(*,*)' End of map 5 misses start of map 6:' + write(*,*)' xEndMap5 = ',xEndMap5 + write(*,*)' xStartMap6 = ',xStartMap6 + write(*,*)' -> STOP' + STOP + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Variable 'artList' auswerten: + + if (artList.NE.' ') call examine_artList + + +c wurde die Variable 'artList' nicht gesetzt, setze 'UseDecay' auf .false.: + + if (.NOT.artList_defined) then + if (UseDecay) then + UseDecay = .false. + write(*,1000) 'Myonen-Zerfall nur bei Verwendung von '// + + '''ArtList''','UseDecay = .false. gesetzt' + flag_message = .true. + endif + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Startgebiet und -Koordinate festlegen: + + if (StartFlaeche.EQ.-1) then + if (x0_.LE.0) then + x0_ = 0. + Startflaeche = 0 + Gebiet0 = target + elseif (x0_.LE.xPosition_Grid1) then + Gebiet0 = upToGrid1 + if (x0_.EQ.xPosition_Grid1) Startflaeche = 1 + elseif (x0_.LE.xPosition_Grid2) then + Gebiet0 = upToGrid2 + elseif (x0_.LE.rHeShield) then + Gebiet0 = upToHeShield + endif + x0(1) = x0_ + elseif (StartFlaeche.EQ.1) then + Gebiet0 = upToGrid2 + x0(1) = xPosition_Grid1 + elseif (StartFlaeche.EQ.2) then + Gebiet0 = upToHeShield + x0(1) = xPosition_Grid2 + else + Startflaeche = 0 + Gebiet0 = target + x0(1) = xFoil + endif + + +c Falls die Anzahl zufallsverteilter Starts <= 0 sein sollte, vergiss die +c Zufallsstarts: + + if (randomStarts.LE.0) then + random_energy = 0 + random_position = 0 + random_winkel = 0 + endif + + +c Zufallsverteilung fuer Startenergie? + + if (random_energy.GE.1 .AND. random_energy.LE.2) then + random_E0 = .true. + + if (random_energy.EQ.1 .AND..NOT.(lowerE0.EQ.0..AND.upperE0.EQ.0.)) then + if (lowerE0.GT.upperE0) then + help = lowerE0 + lowerE0 = upperE0 + upperE0 = help + endif + random_E0_equal = .true. + + elseif (random_energy.EQ.2 .AND..NOT.(sigmaE0.EQ.0.)) then + random_E0_gauss = .true. + if (adjustSigmaE0) sigmaE0 = -99 + + else + random_E0 = .false. + endif + if (.NOT.random_E0_gauss) adjustSigmaE0 = .false. + + elseif (random_energy.NE.0) then + write(*,*) + write(*,*) 'random_energy = ',random_energy,' is not defined' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c Zufallsverteilung fuer Startpositionen? + + if (random_position.GE.1 .AND. random_position. LE.4) then + random_pos = .true. + ! setze gegebenenfalls Defaultwerte ein. Falls nicht, pruefe ob + ! Startortverteilung innerhalb der Folienflaeche liegt: + + if (startBreite.LT.0.) then + startBreite = 2.*dy_Foil + else + if (startBreite.GT.2.*dy_Foil) then + write(*,*) + write(*,*) 'Startbreite ist groesser als Folienbreite:' + write(*,*) 'Startbreite, Starthoehe = ',startBreite,startHoehe + write(*,*) 'Folienbreite, Folienhoehe = ',2.*dy_Foil,2.*dz_Foil + write(*,*) + call exit + endif + endif + if (startHoehe .LT.0.) then + startHoehe = 2.*dz_Foil + else + if (startHoehe.GT.2.*dz_Foil) then + write(*,*) + write(*,*) 'Starthoehe ist groesser als Folienhoehe:' + write(*,*) 'Startbreite, Starthoehe = ',startBreite,startHoehe + write(*,*) 'Folienbreite, Folienhoehe = ',2.*dy_Foil,2.*dz_Foil + write(*,*) + call exit + endif + endif + + if (startRadius.LT.0.) startRadius = 20. + sigmaPosition = abs(sigmaPosition) + + if (random_position.EQ.1 .AND. + + .NOT.(StartBreite.EQ.0 .AND. StartHoehe.EQ.0)) then + random_y0z0_equal = .true. + + elseif (random_position.EQ.2 .AND. .NOT.StartRadius.EQ.0) then + random_r0_equal = .true. + + elseif (random_position.EQ.3 .AND. .NOT.sigmaPosition.EQ.0. + + .AND. .NOT.(StartBreite.EQ.0 .AND. StartHoehe.EQ.0)) then + random_y0z0_Gauss = .true. + + elseif (random_position.EQ.4 .AND. .NOT.StartRadius.EQ.0. + + .AND. .NOT.sigmaPosition.EQ.0.) then + random_r0_Gauss = .true. + + else + random_pos = .false. + endif + + elseif (random_position.NE.0) then + write(*,*) + write(*,*) 'random_position = ',random_position,' is not defined' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c Zufallsverteilung fuer Startwinkel? + + if (random_winkel.GE.1 .AND. random_winkel.LE.2) then + random_angle = .true. + + if (random_winkel.EQ.1) then + random_lambert = .true. + elseif (random_winkel.EQ.2 .AND. .NOT.sigmaWinkel.EQ.0.) then + random_gauss = .true. + else + random_angle = .false. + endif + + elseif (random_winkel.NE.0) then + write(*,*) + write(*,*) 'random_winkel = ',random_winkel,' is not defined' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Durchlaufzahl fuer die 'Zufallsschleife' richtig setzen: + + if (random_E0.OR.random_pos.OR.random_angle) then + par(2,0) = randomStarts ! (Default = 1) + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c die Parameter fuer die Schleifen setzen und die Gesamtzahl startender +c Projektile berechnen: + + call adjustLoops + + imonitor = min(imonitor,n_par(0)) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (n_par(0).EQ.1) OneStartPerLoop = .true. + SchleifenZahl = GesamtZahl/n_par(0) + if (SchleifenZahl.EQ.1) OneLoop = .true. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c n_par der unbenutzten Schleifen auf 0 setzen (wird von PHYSICA benoetigt): + + if (.NOT.freeGuard) then + n_par(UGuard) = 0 + endif + if (random_E0 .AND. par(2,ener).EQ.0 .OR. E0InterFromFile) then +c n_par(ener) = 0 + ener_offset = .false. + endif + if (random_pos .AND. + + par(1,yPos).EQ.0 .AND .par(2,yPos).EQ.0. .AND. + + par(1,zPos).EQ.0 .AND .par(2,zPos).EQ.0. ) then + n_par(yPos) = 0 + n_par(zPos) = 0 + pos_offset = .false. + endif + if (random_angle .AND. + + par(1,thetAng).EQ.0 .AND .par(2,thetAng).EQ.0. .AND. + + par(1,phiAng).EQ.0 .AND .par(2,phiAng).EQ.0. ) then + n_par(thetAng) = 0 + n_par(phiAng) = 0 + angle_offset = .false. + endif + if (.NOT.random_angle .AND. + + par(1,thetAng).EQ.0 .AND .par(2,thetAng).EQ.0. ) then + n_par(phiAng) = 0 + endif + if (artlist_defined) then + n_par(mass) = 0 + endif + if (par(1,BHelm) .EQ.0. .AND. par(2,BHelm) .EQ.0.) n_par(BHelm) = 0 + if (par(1,BTD) .EQ.0. .AND. par(2,BTD) .EQ.0.) n_par(BTD) = 0 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c falls ausser den fuer Mutrack notwendigen Goessen vom Benutzer zusaetzliche +c Groessen verlangt werden, setze auch 'NTP_Misc' auf .true. (-> StartNr, +c SchleifenNr, Mappe, Steps). + + if (NTP_40mm.AND.scaleFactor.NE.1.) then + write(*,1000) 'NTP_40mm nur bei ScaleFactor = 1 ', + + 'NTP_40m = .false. gesetzt' + flag_message = .true. + endif + if (NTP_Start .OR. NTP_Stop .OR. NTP_40mm) NTP_Misc = .true. + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Bei Debug grundsaetzlich die RunNummern von 9900 bis 9999 verwenden (TestRun). +c Bei Debug soll volles Logfile erstellt werden. + + if (DEBUG) then + if (debug_Anzahl.EQ.0) then + write(*,1000) 'debug_Anzahl = 0','es werden keine'// + + 'DEBUG-Informationen ausgegeben' + flag_message = .true. + debug = .false. + else + if (debug_Anzahl.GT.n_par(0)) debug_Anzahl = n_par(0) + TestRun = .true. + if (n_outWhere.LT.1) then + n_outWhere = 1 + elseif (n_outWhere.GT.2) then + n_outWhere = 2 + endif + endif + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c welche Ausgabekanaele sollen fuer das Summary durchlaufen werden? + + if (n_outWhere.NE.0) then + if (n_outWhere.LT.0 .OR. n_outWhere.GT.3) then + write(*,*) + write(*,*) 'Der Bereich von n_outWhere ist auf '// + + '[0,3] eingeschraenkt!' + write(*,*) + STOP + endif + if (n_outWhere.LE.2) LogFile = .true. ! volles Summary-File + indx1 = int((n_outWhere+1)/2) ! = 1,1,2 fuer n_outWhere=1,2,3 + indx2 = int((n_outWhere+2)/2) ! = 1,2,2 fuer n_outWhere=1,2,3 + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c wenn keine Ausgabe des LOG-files vorgesehen ist, aber das PHYSICA-file +c und/oder das NTP-file erzeugt werden sollen, dann ist zumindest die +c Minimalversion des LOG-files zu erstellen: + + if (.NOT.LogFile .AND. (createPhysTab.OR.NTP_Misc)) then + smallLogFile = .true. ! Minimalversion erzeugen + indx1 = 1 + if (n_outWhere.EQ.0) indx2 = 1 + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der logicals fuer die im Logfile auszugebenden Statistiken: + +c statInSummary(Nr_S1M2) = SUM_S1M2 + + +c Uebertragen der logicals fuer die zu erzeugenden Tabellen: + +c createTabelle(Nr_S1M2) = TAB_S1M2 + + +c Falls weder grosses noch kleines Summary ausgegeben werden soll, und auch die +c Bildschirmausgabe unterbleibt, setze alle statInSummary auf .false.: + + if (.NOT.(LogFile .OR. smallLogFile) .AND. n_outWhere.LT.2) then + do k = 1, stat_Anzahl + statInSummary(k) = .false. + enddo + endif + + +c Falls (abgesehen von der PHYSICA-Tabelle) irgendwelche Tabellen +c gewuenscht werden, setze 'createTabellen' auf .true.: + + do k = 1, Stat_Anzahl + if (createTabelle(k)) then + createTabellen = .true. + endif + enddo + + +c Sollte pro Schleife nur ein Teilchenstart erfolgen oder umgekehrt ausser +c der 'Zufalls-Schleife' keine anderen Schleife durchlaufen werden, dann +c unterlasse die Ausgabe von Tabellen. + + if (OneStartPerLoop.OR.OneLoop) then + if (createPhysTab) then + flag = .true. + if (OneLoop) then + write(*,1000) 'nur eine Schleife', + + 'PHYSICA-Tabelle wird nicht erzeugt' + else + write(*,1000) 'nur ein Start pro Schleife', + + 'PHYSICA-Tabelle wird nicht erzeugt' + endif + flag_message = .true. + createPhysTab = .false. + else + flag = .false. + endif + if (createTabellen) then + if (flag) then + write(*,1000) ' ', + + 'Tabellen-files werden nicht erzeugt' + elseif (OneLoop) then + write(*,1000) 'nur eine Schleife', + + 'Tabellen-files werden nicht erzeugt' + else + write(*,1000) 'nur ein Start pro Schleife', + + 'Tabellen-files werden nicht erzeugt' + endif + flag_message = .true. + do k = 1, Stat_Anzahl + createTabelle(k) = .false. + enddo + createTabellen = .false. + endif + endif + + if (n_outWhere.LT.0) n_outWhere = 0 + + +c falls im Summary irgendwelche Statistiken ausgegeben werden sollen, setze +c 'statsInSummary' auf .true.: + + do k = 1, stat_Anzahl + if (statInSummary(k)) then + statsInSummary = .true. + endif + enddo + + +c pruefe, fuer welche Groessen Statistiken gefuehrt werden muessen, und setze +c das jeweilige 'statNeeded' auf .true.: + + if (createPhysTab) then ! alle Statistiken benoetigt! + do k = 1, Stat_Anzahl + statNeeded(k) = .true. + enddo + else ! einzelne Statistiken benoetigt? + do k = 1, Stat_Anzahl + if (createTabelle(k).OR.statInSummary(k)) then + statNeeded(k) = .true. + endif + enddo + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +1000 format(x,A,T36,'->',T40,A) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c falls Parameter abgeaendert worden sind, hole Bestaetigung ein: + + if (.NOT.(NTP_Misc.OR.createPhysTab.OR.createTabellen.OR. + + graphics.OR.LogFile.OR.smallLogFile.OR.n_outWhere.GT.1)) then + write(*,*) + write(*,*)' > You don''t want to have a logfile' + write(*,*)' > You don''t desire a display on the screen.' + write(*,*)' > You do not want to have a nice graphics of ', + + 'the calculated trajectories.' + write(*,*)' > You don''t ask me to create a Ntuple or a ', + + 'PHYSICA readable file.' + write(*,*)' > And you do not long for having the result in ', + + 'tabulated form.' + write(*,*) + write(*,*)' HEY MAN, YOU ARE NOT PRODUCING ANY OUTPUT!!' + write(*,*)' ARE YOU SURE YOU WANT ME TO WORK JUST FOR FUN?' + write(*,*) + flag_message = .true. + endif + + if (flag_message .AND. .NOT.BATCH_MODE) then + write(*,1010) + accept 1011, antwort +1010 format(' ok? ( = ABBRUCH)',T36'-> ',$) +1011 format(A5) ! bis zu vier Leerzeichen vor Buchstaben werden akzeptiert + + k = 0 +40 k = k+1 + if (antwort(k:k).eq.' ' .AND. k.LE.4) then + goto 40 + elseif (antwort(k:k).eq.'n' .or. antwort(k:k).eq.'N' .or. + + antwort(k:k).eq.'a' .or. antwort(k:k).eq.'A' .or. + + antwort(k:k).eq.'c' .or. antwort(k:k).eq.'C' ) then + write(*,*) + STOP + endif + endif + + +c bei Verwendung von 'input_list' korrigiere noetigenfalls den Wert von +c 'testRun': + + if (input_list.AND.gotFileNr) testRun = testRun_ + + +c falls kein Summary-File erstellt wird, braucht auch die 'T E S T - R U N' - +c Meldung nicht auf dem Bildschirm erscheinen: + + if (.NOT.(logFile.OR.smallLogFile)) testRun = .false. + + +c Bedingungen fuer die Ausgabe der Prozentzahl schon gerechneter Teilchen +c pruefen: + + if (.NOT.BATCH_MODE .AND. n_par(0).GE.50 .AND. n_outWhere.GE.2) then + log_percent = .true. + endif + + if (batch_mode) graphics = .false. + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE adjustLoops +c ====================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + integer k + real value, help, factor, step + + GesamtZahl=1 + + do k = 0 , par_Anzahl ! k=0: 'Zufalls-Schleife' + if (par(2,k).NE.1.e10) then ! wurde maxWert vorgegeben? + if (par(2,k).EQ.par(1,k).OR.par(3,k).EQ.0.) then + par(3,k) = 1. ! step = 0 vermeiden + else ! wurde step vorgegeben? + if (par(3,k).EQ.-1.e10) par(3,k)=par(2,k)-par(1,k) + endif + else + par(2,k) = par(1,k) + par(3,k) = 1. + endif + + ! es kam vor, dass wegen der endlichen Genauigkeit numerischer Zahlen + ! die letzte Schleife nicht durchlaufen wurde. Deshalb wurden folgende + ! Befehlszeilen eingebaut: + + factor = 1 + step = par(3,k) + +10 do help = par(1,k), par(2,k), step + value = help + enddo + + if (abs((value-par(2,k))/step) .GT. 0.1) then + factor = factor - 0.00000003 + step = par(3,k) * factor + goto 10 + endif + par(3,k) = step + + n_par(k) = int((par(2,k)-par(1,k)+par(3,k))/par(3,k) +.5) ! so werden laut + if (n_par(k).LE.0) n_par(k)=1 ! library die Anzahlen der Durchlaeufe berechnet + +99 GesamtZahl = GesamtZahl * n_par(k) + + +c setzte Parameter (mit hoeherer Codenummer!), deren Variation sinnlos waere +c auf Null: + + if (k.EQ.ener .AND. .NOT.random_E0 .AND. + + n_par(ener).LE.1 .AND. par(1,ener).EQ.0. ) then + par(1,thetang) = 0. + par(2,thetang) = 0. + par(1,phiAng) = 0. + par(2,phiAng) = 0. + random_angle = .false. + random_lambert = .false. + random_gauss = .false. + + elseif (k.EQ.thetAng .AND. + + n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. ) then + par(1,phiAng) = 0. + par(2,phiAng) = 0. + + endif + + enddo + + END + + +c=============================================================================== diff --git a/accel/src/SUB_INTEGR_1.FOR b/accel/src/SUB_INTEGR_1.FOR new file mode 100644 index 0000000..d89e325 --- /dev/null +++ b/accel/src/SUB_INTEGR_1.FOR @@ -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=============================================================================== diff --git a/accel/src/SUB_INTEGR_2.FOR b/accel/src/SUB_INTEGR_2.FOR new file mode 100644 index 0000000..6a7a755 --- /dev/null +++ b/accel/src/SUB_INTEGR_2.FOR @@ -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=============================================================================== diff --git a/accel/src/SUB_INTEGR_3.FOR b/accel/src/SUB_INTEGR_3.FOR new file mode 100644 index 0000000..26d9975 --- /dev/null +++ b/accel/src/SUB_INTEGR_3.FOR @@ -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=============================================================================== diff --git a/accel/src/SUB_INTEGR_4.FOR b/accel/src/SUB_INTEGR_4.FOR new file mode 100644 index 0000000..4dce157 --- /dev/null +++ b/accel/src/SUB_INTEGR_4.FOR @@ -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=============================================================================== diff --git a/accel/src/SUB_INTEGR_5.FOR b/accel/src/SUB_INTEGR_5.FOR new file mode 100644 index 0000000..1682779 --- /dev/null +++ b/accel/src/SUB_INTEGR_5.FOR @@ -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=============================================================================== diff --git a/accel/src/SUB_INTEGR_6.FOR b/accel/src/SUB_INTEGR_6.FOR new file mode 100644 index 0000000..466b3f0 --- /dev/null +++ b/accel/src/SUB_INTEGR_6.FOR @@ -0,0 +1,1007 @@ + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFOS +c ===================== + + logical map_error /.false./ + COMMON /map_error/ map_error + + CALL READ_INFO_6 ! Die Reihenfolge der 'READ_INFO_x'-calls + CALL READ_INFO_5 ! ist wichtig (wegen Uebermittlung der + CALL READ_INFO_4 ! Uebergabebereiche) + CALL READ_INFO_3 + CALL READ_INFO_2 + CALL READ_INFO_1 + + if (map_error) then + write(*,*) '-----------------------------------------------------------' + write(*,*) + write(*,*) ' => Files ''MAP_DEF_x.INC'' (x == Nr. der Mappe) im Directory' + write(*,*) ' ''accel$sourcedirectory:'' angleichen und anschliessend' + write(*,*) ' das Programm mit ''LINKACV'' am DCL Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) '-----------------------------------------------------------' + write(*,*) + STOP + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_6 +c ====================== + + IMPLICIT NONE + + character*1 Nr + parameter (Nr='6') + + INCLUDE 'accel$sourcedirectory:COM_GEO.INC' + INCLUDE 'accel$sourcedirectory:COM_HVs.INC' + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + INCLUDE 'accel$sourcedirectory:MAP_DEF_6.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c nur um Mappeninfos fuer Runs vor Run 10 weiterhin lesen zu koennen +c (wurden ab Version 1.2.1 ersetzt durch outerDy_TgtHolder, outerDz_TgtHolder): + + real Dy_TgtHolder, Dz_TgtHolder + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + namelist /voltages/ UTgt, UGua, UGrid1, UG1, UG2, zero + + namelist /geometry/ + + Dy_Foil,Dz_Foil,xEnd_TgtHolder,Dy_TgtHolder,Dz_TgtHolder, + + outerDy_TgtHolder,outerDz_TgtHolder, + + innerDy1_TgtHolder,innerDz1_TgtHolder,innerDy2_TgtHolder,innerDz2_TgtHolder, + + xStart_Guardring,xEnd_Guardring,innerDy_Guardring,outerDy_Guardring, + + innerDz_Guardring,outerDz_Guardring, + + xPosition_Grid1,distance_wires1,dWires1,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,y_Pos_firstWire2,y_Pos_lastWire2, + + xStart_Gridframe2,xEnd_Gridframe2,innerDy_Gridframe2,outerDy_Gridframe2, + + innerDz_Gridframe2,outerDz_Gridframe2, + + xHeShield,rHeShield + +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_6.INC definiert + + namelist /grid_info/ + + Dx,Dy,Dz, imax,jmax,kmax, x_iEQ1, xmin,xmax,ymax,zmax + + + integer iostat + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Versuchen, ein Mappenfile mit fixer HV-Einstellung zu oeffnen (d.h. ein +c Mappenfile ohne Erweiterung '_Tgt' bzw. '_Gua' bzw. '_Gi1'). Gelingt dies, so +c verwende fuer die Hochspannungen an Target und 1. Gitter die Spannungen, +c fuer die die Mappe gerechnet wurde (-> 'HVs_from_map = .true.). Ansonsten +c verwende die von ACCEL.INPUT eingelesenen Vorgaben fuer die HV-Schleifen: + + open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.MAPPE', + + readonly,status='old',iostat=iostat) + if (iostat.EQ.0) then + HVs_from_map = .true. ! Default = .false. + close (lunREAD) + endif + + +c Einlesen der Mappen-Informationen (bei Mappe 6 auch Spannungen und Geometrie +c des Targetbereiches): + + open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.INFO', + + readonly,status='old') + read(lunREAD,nml=grid_info) + rewind (lunREAD) + UGua = -1.E10 + read(lunREAD,nml=voltages) + if (UGua.NE.-1.E10) then + ! Es wurde ein Spannungswert fuer den Guardring angegeben. + ! => Guardring hat eigene Spannungseinstellung + freeGuard = .true. + else + freeGuard = .false. + par(1,UGuard) = 0 + par(2,UGuard) = 0 + par(3,UGuard) = 1 + endif + rewind (lunREAD) + read(lunREAD,nml=geometry) + close (lunREAD) + + if (outerDy_TgtHolder.EQ.-1.E10) outerDy_TgtHolder = Dy_TgtHolder + if (outerDz_TgtHolder.EQ.-1.E10) outerDz_TgtHolder = Dz_TgtHolder + if (innerDy1_TgtHolder.EQ.-1.E10) innerDy1_TgtHolder = Dy_Foil + if (innerDz1_TgtHolder.EQ.-1.E10) innerDz1_TgtHolder = Dz_Foil + if (innerDy2_TgtHolder.EQ.-1.E10) innerDy2_TgtHolder = Dy_Foil + if (innerDz2_TgtHolder.EQ.-1.E10) innerDz2_TgtHolder = Dz_Foil + + if (HVs_from_map) then + ! Die eingelesenen Spannungen an die Variablen fuer die + ! zugehoerigen Schleifen weitergeben (nur bei Mappe 6): + par(1,UTarget) = UTgt + par(2,UTarget) = UTgt + par(3,UTarget) = 1 + if (freeGuard) then + par(1,UGuard) = UGua + par(2,UGuard) = UGua + par(3,UGuard) = 1 + endif + par(1,UGi1) = UG1 + par(2,UGi1) = UG1 + par(3,UGi1) = 1 + endif + + +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: + + xFoil = -xHeShield + xHeShield = 0. + + xmin = xmin + xFoil + xmax = xmax + xFoil + + xStartMap6 = xmin + xEndMap6 = xmax + + xEnd_TgtHolder = xEnd_TgtHolder + xFoil + xStart_Guardring = xStart_Guardring + xFoil + xEnd_Guardring = xEnd_Guardring + xFoil + + xPosition_Grid1 = xPosition_Grid1 + xFoil + xStart_Gridframe1 = xStart_Gridframe1 + xFoil + xEnd_Gridframe1 = xEnd_Gridframe1 + xFoil + xStart_Balken = xStart_Balken + xFoil + xEnd_Balken = xEnd_Balken + xFoil + + xPosition_Grid2 = xPosition_Grid2 + xFoil + xStart_Gridframe2 = xStart_Gridframe2 + xFoil + xEnd_Gridframe2 = xEnd_Gridframe2 + xFoil + + rWires1 = dWires1/2. + rQuadWires1 = rWires1*rWires1 + rWires2 = dWires2/2. + rQuadWires2 = rWires2*rWires2 + + +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: +Cc (Die Laenge von Mappe 6 ist abhaengig von der Position des Moderators relativ +Cc zur Kryoachse.) +C +C if ( +Cc + 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_6 +c ===================== + + IMPLICIT NONE + + character*1 Nr + parameter (Nr='6') + + INCLUDE 'accel$sourcedirectory:MAP_DEF_6.INC' + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE ADD_MAP_6 +c ==================== + + IMPLICIT NONE + + character*1 Nr + parameter (Nr='6') + + INCLUDE 'accel$sourcedirectory:MAP_DEF_6.INC' + 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 der '_Gua_Nr'-Potentialmappe und Angleichen an UGua: + + 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 der '_Gi1_Nr'-Potentialmappe und Angleichen an UG1: + + 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 + map(ihelp) = map(ihelp) + UG1*abs(read_memory(i)) + ihelp = ihelp + 1 + enddo + enddo + enddo + close(lunREAD) + + + RETURN + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_6(dt) +c ============================================= + + IMPLICIT NONE + SAVE + + character*1 Nr + parameter (Nr='6') + +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_6.INC' + + 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 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. + + integer returnCode_EFeld + COMMON /returnCode_EFeld/ returnCode_EFeld + ! 1: Testort hinter der Mappe + ! 2: Testort neben der Mappe + ! 3: Testort vor der Mappe + + logical flag_hang + COMMON /flag_hang/ flag_hang + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + flag_dtSmall = .false. ! flag resetten + 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_6(x,EFeld0,*999) + +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_6(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_6(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_6(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_6(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) 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) + + maxErr = Max(maxErr_x,maxErr_v) + + if (maxErr.GT.1.) then + 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 + + +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) + Dx1(1) + xDifferenz(1) / 15. + 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 neuen Zeitschritt so gross wie sinnvoller weise moeglich machen: + + 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 + + + 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 oder +c an einem Testort: + +999 if (returnCode_EFeld.EQ.2) then + destiny = code_neben_Mappe + elseif (returnCode_EFeld.EQ.3) then + destiny = code_reflektiert + if (v(1).GT.0) then ! in Vorwaertsbewegung -> sollte nicht vorkommen!! + write(*,*) + write(*,*) 'Mappe '//Nr//':' + write(*,*) + write(*,*)' Test-x liegt vor der Mappe!' + write(*,*)' t = ',t + write(*,*)' x = ',x + write(*,*)' v = ',v + write(*,*)' Teilchen-Nr = ',Start_Nr + write(*,*) + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_6(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_6(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_6(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_6(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_6(x,E,*) +c ========================= + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:MAP_DEF_6.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: + +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 + E(1) = 0. + E(2) = 0. ! Spezialbehandlung bei Mappe 6 ! + E(3) = 0. + RETURN + elseif (real_i.LT.0.) then + if (real_i.GE.-.1e-6) then + real_i = 0. + else + 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 + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE ERROR_MESSAGE_AND_STOP(text1,text2) +c ============================================== + + character*(*) text1,text2 + + write(*,*) + write(*,*) ' ERROR MESSAGE FROM SUBROUTINE '//text1 + write(*,*) + write(*,*) ' >>> '//text2 + write(*,*) + write(*,*) ' -> STOP' + write(*,*) + call exit + + END + + +c=============================================================================== diff --git a/accel/src/SUB_OUTPUT.FOR b/accel/src/SUB_OUTPUT.FOR new file mode 100644 index 0000000..a90b0d3 --- /dev/null +++ b/accel/src/SUB_OUTPUT.FOR @@ -0,0 +1,1705 @@ + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INITIALIZE_OUTPUT +c ============================ + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + + integer l, k, iostat, par_ + integer fileNr + integer fileNrReal /0/, fileNrTest /9900/ ! laufende Nummern der + ! Ausgabe-files + + character antwort*5,zeile*80 + + character*80 varNames,loopZeile,parValues + COMMON /zeilen/ varNames,loopZeile,parValues + + character*80 strichU,strich1,strich2 + parameter(strichU = '________________________________________'// + + '________________________________________', + + strich1 = '----------------------------------------'// + + '----------------------------------------', + + strich2 = '========================================'// + + '========================================') + + integer PHYSICA_ZeilenVektor(15) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (.NOT.gotFileNr) then + +c den Namen der Ausgabe-files definieren: + + if (LogFile.OR.smallLogFile.OR.input_list) then + open(lunREAD,file='ACCEL_NR.DAT',defaultfile=NrDir, + + status='OLD',iostat=iostat) + if (iostat.EQ.0) then + read(lunREAD,*) fileNrReal,fileNrTest! die aktuelle Dateinummer einlesen + close(lunREAD) + endif + if (TestRun) then + fileNr = fileNrTest + 1 + if (fileNr.EQ.10000) fileNr = 9900 + else + fileNr = fileNrReal + 1 + endif + write(filename(4:7),'(I4)')fileNr + if (fileNr.LE.999) write (filename(4:4),'(A1)') '0' + if (fileNr.LE. 99) write (filename(5:5),'(A1)') '0' + if (fileNr.LE. 9) write (filename(6:6),'(A1)') '0' + + if (input_list) then + ! Ausgabe der (negativen) fileNr in die 'inputListe': + open(lunRead,file=inputListName//'.INPUT',status='old',iostat=iostat, + + defaultfile=readDir) + if (iostat.NE.0) then + write(*,*) ' Kann '''//inputListName//'.INPUT'' nicht oeffnen' + write(*,*) + call exit + endif + do k = 1,ListLength + read(lunRead,*) + enddo + read(lunRead,*) k ! Nummer des aktuell bearbeitete files + write(lunRead,*) -fileNr + close(lunRead) + + if (TestRun) then ! + fileNrTest = fileNrTest+k ! reserviere k Nummern fuer die + else ! k noch ausstehenden Eingabe- + fileNrReal = fileNrReal+k ! files der input_liste! + endif + open(lunREAD,file='ACCEL_NR.DAT',defaultfile=NrDir, + + status='OLD',iostat=iostat) + if (iostat.NE.0) then + write(*,*) ' ================================================' + write(*,*) ' create file '//NrDir//':ACCEL_NR.DAT' + write(*,*) ' ================================================' + open(lunREAD,file='ACCEL_NR.DAT',defaultfile=NrDir, + + status='NEW') + endif + write(lunREAD,*) fileNrReal,fileNrTest + write(lunREAD,*) 'Diese Datei enthaelt die zuletzt'// + + ' vergebene Nummer ''nnnn'' fuer die' + write(lunREAD,*) 'Ausgabedateien ''AC_nnnn'' des Programms'// + + ' ACCEL (separat fuer RealRuns' + write(lunREAD,*) 'und TestRuns).' + close(lunREAD) + + endif + + else + fileName = ' ' + endif + + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Header zusammen stellen: + + call Make_HeaderFile + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Header auf Schirm ausgeben und abfragen, ob Einstellungen in Ordnung sind: +c (letzteres nur, falls interaktiv gearbeitet wird). + + write(*,*) strich2 + + k = 0 + l = 0 + rewind(lunTMP) +997 read (lunTMP,'(A)',END=998) zeile + write (*,'(x,A)') zeile + + ! gleich noch pruefen, welche Zeilen vom PHYSICA-Macro 'MULOG.PCM' + ! eingelesen werden sollen: + if (createPhysTab) then + k = k + 1 + if (zeile(1:10).EQ.'Projektile' .OR. + + zeile(1:5 ).EQ.'Start' .OR. + + index(zeile(1:3),'>').NE.0) then + l = l + 1 + PHYSICA_ZeilenVektor(l+2) = k + endif + endif + goto 997 + +998 if (createPhysTab) then + PHYSICA_ZeilenVektor(1) = k ! Anzahl HeaderZeilen + PHYSICA_ZeilenVektor(2) = l ! Anzahl spezieller Headerzeilen + endif + + if (.NOT.BATCH_MODE) then + write(*,1010) + accept 1011, antwort +1010 format(T27,'ok? ( = ABBRUCH) -> ',$) +1011 format(A5) ! bis zu vier Leerzeichen vor Buchstaben werden akzeptiert + + k = 0 +1 k = k+1 + if (antwort(k:k).eq.' ' .AND. k.LE.4) then + goto 1 + elseif (antwort(k:k).eq.'n' .or. antwort(k:k).eq.'N' .or. + + antwort(k:k).eq.'a' .or. antwort(k:k).eq.'A' .or. + + antwort(k:k).eq.'c' .or. antwort(k:k).eq.'C' ) then + close (lunTMP) + write(*,'(A)') strich2 + write(*,*) + STOP + endif + if (OneLoop) write(*,'(A)') strich2 + endif + + if ((LogFile.OR.smallLogFile) .AND. .NOT.input_list) then + if (TestRun) then + fileNrTest = fileNr + else + fileNrReal = fileNr + endif + open(lunREAD,file='ACCEL_NR.DAT',defaultfile=NrDir, + + status='OLD',iostat=iostat) + if (iostat.NE.0) then + write(*,*) ' ================================================' + write(*,*) ' create file '//NrDir//'ACCEL_NR.DAT' + write(*,*) ' ================================================' + open(lunREAD,file='ACCEL_NR.DAT',defaultfile=NrDir, + + status='NEW') + endif + write(lunREAD,*) fileNrReal,fileNrTest + write(lunREAD,*) 'Diese Datei enthaelt die zuletzt'// + + ' vergebene Nummer ''nnnn'' fuer die' + write(lunREAD,*) 'Ausgabedateien ''AC_nnnn'' des Programms'// + + ' ACCEL (separat fuer RealRuns' + write(lunREAD,*) 'und TestRuns).' + close(lunREAD) + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c falls gewuenscht: Ausgabe-Datei .LOG oeffnen und Header schreiben: + + if (smallLogFile.OR.createTabellen) call Make_VarNames + + if (LogFile .OR. smallLogFile) then + open(lun(1),file=filename//'.LOG', + + defaultfile=outDir, + + status='NEW',carriagecontrol='LIST') + + rewind(lunTMP) +995 read (lunTMP,'(A)',END=996) zeile + write (lun(1),'(A)') zeile + goto 995 + +996 if (smallLogFile) then + write(lun(1),*) + write(lun(1),'(A)') varNames + write(lun(1),'(A)') strich1 + endif + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c die Ausgabe-files fuer die Tabellen initialisieren: + + if (smallLogFile.OR.createTabellen) call Make_VarNames + + if (createTabellen) then + do l= 1, stat_Anzahl + if (createTabelle(l)) then + open(lunPHYSICA+l,file=filename//TabExt(l), + + defaultfile=outDir, + + carriagecontrol='LIST',status='NEW') + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,'(T35,A)') statName(l) + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,'(A)') strich2 + + rewind(lunTMP) +993 read (lunTMP,'(A)',END=994) zeile + write (lunPHYSICA+l,'(A)') zeile + goto 993 + +994 write(lunPHYSICA+l,*) + write(lunPHYSICA+l,'(A)') varNames + write(lunPHYSICA+l,'(A)') '_Nr_________mean____'// + + 'Varianz_____________von_______bis___________Anzahl______%___' + write(lunPHYSICA+l,*) + endif + enddo + endif + + +c das Header file schliessen (und dabei loeschen): + + close(lunTMP) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c falls verlangt, die Gesamt-Tabelle 'filename.PHYSICA' oeffnen und das Feld +c PHYSICA_ZeilenVektor in die ersten Zeilen schreiben. Die Anzahlen der +c unterschiedlichen Schleifenparameter und der verschiedenen Statistiken, +c die Gesamtzahl der Schleifen, und die Anzahl der Projektile je Schleife in +c Zeile 2. +c Anschliessend fuer jeden SchleifenParameter in der Reihenfolge der Schleifen- +c aufrufe die Nummer, die Anzahl der Werte, Minimalwert, Maximalwert und +c Schrittgroesse ausgeben: +c +c 1. Zeile: PHYSICA_ZeilenVektor +c 2. Zeile: par_Anzahl, stat_Anzahl, Schleifenzahl, StartsProSchleife +c 3. Zeile bis (par_Anzahl). Zeile: Reihenfolge(i), n_par(Reihenfolge(i) + + if (createPhysTab) then + open(lunPHYSICA,file=fileName//'.PHYSICA',defaultfile=outDir, + + carriagecontrol='LIST',status='NEW') + + write(lunPHYSICA,999) (PHYSICA_ZeilenVektor(k), k=1,15) +999 format (15(x,I3,:)) + write(lunPHYSICA,992) par_Anzahl,stat_Anzahl, + + SchleifenZahl,n_par(0) +992 format (15(x,I6,:)) + do k=1,par_Anzahl + par_ = reihenFolge(k) + write(lunPHYSICA,1000) par_, n_par(par_), + + par(1,par_),par(2,par_),par(3,par_) + enddo + endif +1000 format (x,I2,2X,I4,2X,F,2x,F,2X,F) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_HeaderFile +c ========================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + INCLUDE 'accel$sourcedirectory:COM_GEO.INC' + + integer i,k,par_,pos + logical flag /.false./ + + character datum*9,uhrzeit*8,helpChar*1 + + character*40 inputName + COMMON /inputName/ inputName + + character*80 zeile,strichU,strich1,strich2 + parameter(strichU = '________________________________________'// + + '________________________________________', + + strich1 = '----------------------------------------'// + + '----------------------------------------', + + strich2 = '========================================'// + + '========================================') + + +c Oeffnen des files zur Zwischenspeicherung der Headerzeilen: + + open (lunTMP,File='HEADER.TMP',form='FORMATTED',defaultfile=TMPDir, + + status='SCRATCH',carriagecontrol ='NONE') + + +c I.: allgemeine Settings: +c ------------------------ + + call date(datum) + call time(uhrzeit) + + write(lunTMP,11) filename,version,datum,uhrzeit +11 format(A,T19,'> VERSION 'A' <',T48,'begonnen am ',A,' um ',A) + + +c Einheiten: +c ---------- + + write(lunTMP,'(A)') 'UNITS: Spannung:kV, Winkel:deg, '// + + 'Masse:keV/c**2, Ladung:e, Energie:keV, Laenge:mm' + +c MappenfileName: +c --------------- + + write(lunTMP,'(A)') strich1 + write(lunTMP,'(A)') 'POTENTIALMAPPE: '//mappenName + if (scaleFactor.NE.1.) then + write(lunTMP,'(A,x,F5.2)') 'SCALE FACTOR FOR ACCELLERATOR GEOMETRY: ',scaleFactor + endif + +c Schleifen-Parameter: +c -------------------- + + if (random_E0) par_text(ener)(8:10) = '(*)' + if (random_pos) then + par_text(yPos)(8:10) = '(*)' + par_text(zPos)(8:10) = '(*)' + endif + if (random_angle) then + par_text(thetAng)(8:10) = '(*)' + par_text(phiAng)(8:10) = '(*)' + endif + + write(lunTMP,'(A)') strich1 + + do par_ = 1, par_Anzahl + if (par_.EQ.ener.AND.(ener_offset.OR.pos_offset.OR.angle_offset + + .OR..NOT.(random_E0.AND.random_pos.AND.random_angle))) then + write(lunTMP,*) + endif + if (par_.EQ.UGuard .AND. .NOT.freeGuard) then + ! keine Ausgabe + elseif (par_.EQ.ener .AND. E0InterFromFile) then + if (n_par(ener).EQ.1) then + write(lunTMP,120) par_text(par_),n_par(par_) + else + write(lunTMP,120) par_text(par_),n_par(par_),n_par(par_) + endif + elseif (par_.EQ.ener .AND. random_E0 .AND. + + n_par(ener).LE.1 .AND. par(1,ener).EQ.0.) then + ! keine Ausgabe + elseif ((par_.EQ.BTD .OR. par_.EQ.BHelm) .AND. par(1,par_).EQ.0 + + .AND. par(2,par_).EQ.0 ) then + ! keine Ausgabe + elseif ((par_.EQ.yPos.OR.par_.EQ.zPos) .AND. random_pos .AND. + + n_par(ypos).LE.1 .AND. par(1,ypos).EQ.0. .AND. + + n_par(zpos).LE.1 .AND. par(1,zpos).EQ.0.) then + ! keine Ausgabe + elseif (par_.EQ.thetAng .AND. random_angle. AND. + + n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. .AND. + + n_par(phiAng).LE.1 .AND. par(1,phiAng).EQ.0. ) then + ! keine Ausgabe + elseif (par_.EQ.phiAng .AND. ( + + (random_angle .AND. + + n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. .AND. + + n_par(phiAng).LE.1 .AND. par(1,phiAng).EQ.0.) + + .OR. (.NOT.random_angle .AND. + + n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0.) + + .OR. (.NOT.random_E0 .AND. + + n_par(ener).LE.1 .AND. par(1,ener).EQ.0.) + + )) then + ! keine Ausgabe + elseif ((par_.EQ.mass .OR. par_.EQ.charge) .AND. artList_defined) then + ! keine Ausgabe + else + if (par_.EQ.mass) then + write(lunTMP,*) + endif + if (n_par(par_).EQ.1) then + write(zeile,101) par_text(par_),par(1,par_) + elseif (n_par(par_).EQ.2) then + write(zeile,102) par_text(par_),par(1,par_), + + par(2,par_),n_par(par_) + else + write(zeile,103) par_text(par_),par(1,par_), + + par(2,par_),par(3,par_),n_par(par_) + endif + write(lunTMP,'(A)') zeile + endif + enddo + +101 format(A,2X,F11.3) +102 format(A,' (',F11.3,',',F11.3,')',16X,'(',I5,' Werte)') +103 format(A,' (',F11.3,',',F11.3,',',F11.3,')',T65,'(',I5, + +' Werte)') +120 format(A,I8,' E0-Intervall',:,'e',T65,'(',I5,' Bereiche)') + +c 'ArtList' und neutrale Anteile nach Foliendurchgang: +c ---------------------------------------------------- + + if (artList_defined) then + write(lunTMP,*) + if (n_par(charge).EQ.1.) then + write(zeile,90) artList + else + write(zeile,90) artList,INT(n_par(charge)) + endif + write(lunTMP,'(A)') Zeile + endif +90 format('Projektile : ',A,:,T65,'(',I5,' Werte)') + + write(lunTMP,'(A)') strich1 + + +c Zufallsstarts, Schleifen- und Gesamtzahl: +c ----------------------------------------- + + write(zeile,104) SchleifenZahl,GesamtZahl +104 format(T30,'Schleifen: ',I5,T53,'=> total:',T66,I8, + + ' Starts') + if (random_E0.OR.random_pos.OR.random_angle) then + write(zeile(1:22),105)n_par(0) + else + write(zeile(1:19),'(A)') 'keine Zufallsstarts' + endif +105 format('Zufallsstarts: ',I7) + + write(lunTMP,'(A)') zeile + + +c Zufallsverteilte Startparameter: +c -------------------------------- + +c Energie: + + if (random_E0) then + + if (random_E0_equal) then + if (E0InterFromFile) then + write(zeile, 30) nE0Inter,lowerE0,upperE0 + else + write(zeile, 31) lowerE0,upperE0 + endif +30 format('Startenergie : ',I3,' gleichverteilte Bereiche zwischen ',F6.3,' und ',F6.3) +31 format('Startenergie : gleichverteilt zwischen ',F6.3,' und ',F6.3) + + elseif (random_E0_Gauss) then + if (adjustSigmaE0) then + zeile='Startenergie : adjusted sigma' + else + write(zeile, 32) sigmaE0 +32 format('Startenergie : gaussverteilt (sigma = ',F6.3,')') + endif + endif + if (ener_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70) + write(lunTMP,'(A)') Zeile + endif + + +c Winkel: + + if (random_angle) then + + if (random_winkel.EQ.1) then + write(zeile, 51) StartLambertOrd +51 format('Startwinkel : lambertverteilt (Ordnung: ',F6.2,')') + + elseif (random_gauss) then + write(zeile, 52) SigmaWinkel +52 format('Startwinkel : gaussverteilt (sigma = ',F5.3')') + + endif + if (angle_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70) + write(lunTMP,'(A)') Zeile + endif + + +c Position: + + if (random_pos) then + + if (random_y0z0_equal) then + write(zeile, 41) StartBreite,StartHoehe +41 format('Startposition: gleichverteilt auf Viereck mit ' + + 'dy*dz = ',F5.2,'*',F5.2) + + elseif (random_r0_equal) then + write(zeile, 42) StartRadius +42 format('Startposition: gleichverteilt auf Kreis mit ' + + 'r = ',F5.2) + + elseif (random_y0z0_Gauss) then + write(zeile, 43) sigmaPosition,StartBreite,StartHoehe +43 format('Startposition: gaussverteilt (sigma = 'F5.2,') auf ', + + 'Viereck mit dy*dz = ',F5.2,'*',F5.2) + + elseif (random_r0_Gauss) then + write(zeile, 44) sigmaPosition,StartRadius +44 format('Startposition: gaussverteilt (sigma = 'F5.2,') auf ', + + 'Kreis mit r = ',F5.2) + + endif + if (pos_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70) + write(lunTMP,'(A)') Zeile + endif + + +c Startflaeche: +c ------------- + + if (Startflaeche.EQ.-1) then + write(zeile,53) Gebiet_Text(Gebiet0) +53 format('Startflaeche : Gebiet = ''',A) + pos = 80 + do while (zeile(pos:pos).NE.':') + pos = pos - 1 + enddo + write(zeile(pos:pos+14),54) x0(1) +54 format(''', x0 = ',F7.2) + write(lunTMP,'(A)') zeile + elseif (Startflaeche.EQ.1) then + write(lunTMP,'(A)') 'Startflaeche : 1. Gitter' + elseif (Startflaeche.EQ.2) then + write(lunTMP,'(A)') 'Startflaeche : 2. Gitter' + else + write(lunTMP,'(A)') 'Startflaeche : Moderator' + endif + + write(lunTMP,'(A)') strich2 + + +c Programmsteuerung: +c ------------------ + + if (mu_flag) then + if (UseDecay) then + write(lunTMP,'(A)') 'Myonenzerfall: JA ' + else + write(lunTMP,'(A)') 'Myonenzerfall: NEIN ' + endif + endif + + +c Statistiken fuer das Summary: +c ----------------------------- + + if (statsInSummary) then + zeile = 'Statistiken :' + pos = 16 + do k = 1, stat_Anzahl + if (statInSummary(k)) then + if (pos.GE.72) then + zeile(pos:pos) = ',' + write(lunTMP,'(A)') zeile + zeile = ' ' + pos = 16 + elseif (pos.GT.14) then + zeile(pos:pos) = ',' + pos = pos + 1 + endif + do i = 1, 9 + helpChar = statName(k)(i:i) + if (helpChar.NE.' ' .AND. pos.LE.80) then + zeile(pos:pos) = helpChar + pos = pos+1 + endif + enddo + endif + enddo + write(lunTMP,'(A)') zeile + endif + + +c zu erzeugende Tabellen: +c ----------------------- + + if (createTabellen) then + zeile = 'Tabellen :' + pos = 16 + do k = 1, stat_Anzahl + if (createTabelle(k)) then + if (pos.GE.72) then + zeile(pos:pos) = ',' + write(lunTMP,'(A)') zeile + zeile = ' ' + pos = 16 + elseif (pos.GT.14) then + zeile(pos:pos) = ',' + pos = pos + 1 + endif + zeile(pos:pos) = ',' + pos = pos + 1 + do i = 1, 9 + helpChar = statName(k)(i:i) + if (helpChar.NE.' ' .AND. pos.LE.80) then + zeile(pos:pos) = helpChar + pos = pos+1 + endif + enddo + endif + enddo + write(lunTMP,'(A)') zeile + endif + + if (createPhysTab) write(lunTMP,'(A)') 'PHYSICA-Tabelle erstellen' + +c NTP: +c ---- + + if (NTP_Misc) then + zeile = 'NTP extra :' + pos = 16 + if (NTP_start) then + write(zeile(pos:pos+5),'(A)') 'start,' + pos = pos + 7 + endif + if (NTP_stop) then + write(zeile(pos:pos+4),'(A)') 'stop,' + pos = pos + 6 + endif + if (NTP_40mm) then + write(zeile(pos:pos+5),'(A)') '40mm,' + pos = pos + 6 + endif + zeile(pos-2:pos-2) = ' ' + write(lunTMP,'(A)') zeile + endif + +c Graphikausgabe: +c --------------- + + if (GRAPHICS) then + zeile = 'Graphikausgabe' + pos = 16 + if (n_postSkript.EQ.0) then + write(zeile(pos:pos+18),'(A)')'(keine Postskripts)' + elseif (n_postSkript.EQ.1) then + write(zeile(pos:pos+24),'(A)')'(Postskripts auf Anfrage)' + elseif (n_postSkript.EQ.2) then + write(zeile(pos:pos+17),'(A)')'(alle Postskripts)' + endif + write(lunTMP,'(A)') zeile + + write(lunTMP,'(A,I3,'','',I5,A)') '- iMonitor = ',iMonitor, + + graphics_Anzahl,' Trajektorien pro Schleife' + endif + + +c if (.NOT.GRAPHICS .OR. .NOT.???? .OR. .NOT....) then + if (.NOT.GRAPHICS) then + zeile = '> NICHT ERZEUGT:' + pos = 18 + if (.NOT.GRAPHICS) then + write(zeile(pos:pos+7),'(A)')'GRAPHIK,' + pos = pos + 8 + endif +c if (.NOT.????) then +c write(zeile(pos:pos+7),'(A)')'????,' +c pos = pos + 5 +c endif + pos = pos - 1 + write(zeile(pos:pos+8),'(A)') ' ' + write(lunTMP,'(A)') zeile + endif + + +c Debug: +c ------ + + if (DEBUG) then + write(zeile,132) Debug_Anzahl +132 format('DEBUG-Informationen im LOG-file:',I3, + + ' Projektile je Schleife') + write(lunTMP,'(A)') zeile + if (.NOT.graphics) then + write(lunTMP,'(A,I3)') '- iMonitor = ',iMonitor + endif + endif + + +c Fehlerbetrachtung: +c ------------------ + + write(zeile,141) eps_x,eps_v,dtsmall,maxStep +141 format('eps_x,eps_v = ',E8.3,',',E8.3,T42,', dtsmall = ',F8.6, + + ', maxstep = ',I6) + if (log_relativ) then + write(zeile(33:41),'(A9)') '(relativ)' + else + write(zeile(33:41),'(A9)') '(absolut)' + endif + write(lunTMP,'(A)') zeile + write(lunTMP,'(A,I5)') 'maxBelowDtSmall = ',maxBelowDtSmall + if (log_confine) write(lunTMP,'(A)') ' Schrittweitenbegrenzung' +c if (log_confine) write(lunTMP,142) dl_max_KL,dl_max_FO,dl_max_WL,dl_max +c142 format(' Schrittweitenbegrenzung: KL,FO,WL,M2: ',4(F6.3,:,', ')) + + +c Logfile: +c -------- + + if (.NOT.Logfile) then + if (smallLogFile) then + write(lunTMP,'(A)') 'KLEINES LOGFILE' + else + write(lunTMP,'(T30,A)') '>>> KEIN LOGFILE <<<' + endif + endif + + write(lunTMP,'(A)') strich2 + + +c Kommentarzeilen aus der Eingabedatei ACCEL.INPUT: +c ------------------------------------------------- + + open(lunPHYSICA,file=inputName,defaultfile=readDir//':.INPUT', + + status='OLD',readonly) + flag = .false. +554 read(lunPHYSICA,'(A)') zeile + do while (INDEX(zeile,'$loop_params').EQ.0 .AND. + + INDEX(zeile,'$parameter_liste').EQ.0) + if (zeile(1:2).EQ.'@') then + write(lunTMP,'(A)') zeile + flag = .true. + endif + goto 554 + enddo + close(lunPHYSICA) + + if (flag) write(lunTMP,'(A)') strich2 + + if (TestRun) then + write(lunTMP,'(A)') '######################## >>>>> '// + + 'T E S T - R U N <<<<< ########################' + write(lunTMP,'(A)') strich2 + endif + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_VARNAMES +c ======================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + integer pos + + character*80 varNames,loopZeile,parValues /' '/ + COMMON /zeilen/ varNames,loopZeile,parValues + +c die Zeile 'varNames' mit den Namen derjenigen Schleifen-Parameter +c zusammenstellen, die mehr als einen Wert annehmen (in der Reihenfolge, wie +c sie auch als Schleifen abgearbeitet werden): + + varNames = ' ' + pos = 1 + + +c 'artList' bzw. Masse und Ladung: +c -------------------------------- + + if (artList_defined) then + if (n_par(charge).GT.1) then ! mehr als eine + varNames(1:6) = ' Art ' ! Art spezifiziert + pos = 7 + endif + else + if (n_par(mass).GT.1) then + varNames(pos:pos+12) = ' Masse' + pos = pos+13 + endif + if (n_par(charge).GT.1) then + varNames(pos:pos+3) = ' Q' + pos = pos+4 + endif + endif + +c Startparameter: +c --------------- + +c if (.NOT.random_E0 .AND. n_par(ener).GT.1) then + if (n_par(ener).GT.1) then + varNames(pos:pos+10) = ' Energie' + pos = pos+11 + endif + +c if (.NOT.random_pos) then + if (n_par(yPos).GT.1) then + varNames(pos:pos+8) = ' y0' + pos = pos+9 + endif + if (n_par(zPos).GT.1) then + varNames(pos:pos+8) = ' z0' + pos = pos+9 + endif +c endif + +c if (.NOT.random_angle) then + if (n_par(thetAng).GT.1) then + varNames(pos:pos+8) = ' phi0' + pos = pos+9 + endif + if (n_par(phiAng).GT.1) then + varNames(pos:pos+8) = ' theta0' + pos = pos+9 + endif +c endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_ParValues +c ========================= + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + integer pos + + character*80 varNames,loopZeile,parValues /' '/ + COMMON /zeilen/ varNames,loopZeile,parValues + +c die Zeile 'varValues' mit den aktuellen Werten derjenigen Schleifen-Parameter +c zusammenstellen, die mehr als einen Wert annehmen (in der Reihenfolge, wie +c sie auch als Schleifen abgearbeitet werden): + + parValues = ' ' + pos = 1 + +c 'artList' bzw. Masse und Ladung: +c -------------------------------- + + if (artList_defined) then + if (n_par(charge).GT.1) then + write(parValues(2:5),'(A4)') art_Name(artNr) + pos = 7 + endif + else + if (n_par(mass).GT.1) then + write(parValues(pos+1:pos+12),'(F12.2)') parWert(6) + pos = pos+13 + endif + if (n_par(charge).GT.1) then + write(parValues(pos+2:pos+3),'(SP,I2)') INT(parWert(5)) + pos = pos+4 + endif + endif + + +c Startparameter: +c --------------- + +c if (.NOT.random_E0 .AND. n_par(ener).GT.1) then + if (n_par(ener).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(ener) + pos = pos+11 + endif + +c if (.NOT.random_pos) then + if (n_par(yPos).GT.1) then + write(parValues(pos+2:pos+8),'(F7.2)') parWert(yPos) + pos = pos+9 + endif + if (n_par(zPos).GT.1) then + write(parValues(pos+2:pos+8),'(F7.2)') parWert(zPos) + pos = pos+9 + endif +c endif + +c if (.NOT.random_angle) then + if (n_par(thetAng).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(ThetAng) + pos = pos+9 + endif + if (n_par(phiAng).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(phiAng) + pos = pos+9 + endif +c endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE OUTPUT_NEW_LOOP +c ========================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + + integer k, par_, iostat + + character*80 varNames,loopZeile,parValues /' '/ + COMMON /zeilen/ varNames,loopZeile,parValues + + character datum*9,uhrzeit*8 + + + if (SchleifenNr.EQ.1) then + write(*,'(A)')'==========================='// + + '=====================================================' + if (OneStartPerLoop) then + do indx = indx1, indx2 +c if (Gesamtzahl.GT.1) then + write(lun(indx),*) 'Nur ein Start pro '// + + 'Schleife => Summary geht ueber alle Schleifen' +c else +c write(lun(indx),*) 'Nur ein Start => kein ' +c + 'Summary' +c endif + enddo + RETURN + endif + endif + + +c die Zeile mit der Schleifennummer und dem Startnummernbereich der +c Schleife erstellen: (n_par(0) = #(StartsProSchleife)) + + write(loopZeile(1:80),999)SchleifenNr,SchleifenZahl, + + (SchleifenNr-1)*n_par(0)+1,SchleifenNr*n_par(0) +999 format (' >>> Schleife :',2X,I4,' von ',I4,T45,'Start-Nr:', + + I8,' bis',I8) + + +c falls Run im BATCH_MODE laeuft: gib 'loopZeile' in die Datei 'filename.MESSAG +c aus, damit man sich jederzeit informieren kann, an welcher Stelle der Run ge- +c rade steht: + + + if (BATCH_MODE) then + if (INPUT_LIST) then + open(lunMessage,file='AC_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + read (lunMessage,*,iostat=iostat) ! Nr. der Input-Datei in INPUT_LIST.INPUT + else + open(lunMessage,file='ACCEL.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + endif + read (lunMessage,*,iostat=iostat) ! Startzeitpunkt + read (lunMessage,*,iostat=iostat) ! Name der Input-Datei in INPUT_LIST.INPUT + write(lunMessage,*,iostat=iostat) filename + write(lunMessage,*,iostat=iostat) loopZeile + call date(datum) + call time(uhrzeit) + write(lunMessage,*,iostat=iostat) ' started on '//datum//' at '//uhrzeit + close(lunMessage,iostat=iostat) + endif + + +c die aktuellen Einstellungen der variablen Parameter in 'parValues' schreiben: + + if (smallLogfile.OR.createTabellen) call Make_parValues + + +c falls nur die Minimalversion der .LOG-Datei erstellt werden soll, schreibe +c die entsprechenden Zeilen in die Datei: + + if (smallLogFile) then + write(lun(1),'(A)') loopZeile + write(lun(1),'(A)') parValues + write(lun(1),*) + endif + + +c gib die aktuellen Einstellungen der variablen Parameter (parWert) aus: +c (hier Zeile fuer Zeile) + + if (n_outWhere.NE.0) then + do 1, indx = indx1, indx2 + write(lun(indx),'(A)')loopZeile + do k=1, par_anzahl + par_ = reihenfolge(k) + if (par_.EQ.ener .AND. e0InterFromFile) then + write(lun(indx),1002) nint(parWert(ener)),lowerE0,upperE0 + elseif (n_par(par_).GT.1) then + if (par_.EQ.charge .AND. artList_defined) then + write(lun(indx),1000) art_Name(artNr) + else + write(lun(indx),1001) par_text(par_)(1:10), + + parWert(par_) + endif + endif + enddo +1 continue + endif +1000 format (X,' >>> Projektil :',7X,A) +1001 format (X,' >>> ',A,': ',F10.3) +1002 format (X,' >>> ',I3,'. E0-Intervall: [',F8.3,',',F8.3,']') + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE GRAPHICS_TEXT +c ======================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + integer k,zeile,par_ + integer GraphTextZeilen /15/ + + character graphText(15)*30 /15*' '/ + COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText + + + graphText(1) = filename + zeile = 2 + + if (.NOT.OneStartPerLoop) then + write(graphText(zeile),900) SchleifenNr,SchleifenZahl + zeile = zeile + 1 + endif +900 format('Schleife ',I5,' von ',I6) + + graphText(zeile) = 'MAPPE = '//mappenName + + if (OneStartPerLoop) then + graphText(zeile+1) = 'Ein Start pro Schleife, daher' + graphText(zeile+2) = 'alle Kurven in einer Graphik.' + zeile = zeile + 3 + endif + + do k=1, par_anzahl + par_ = reihenfolge(k) + if (par_.EQ.mass.AND.artList_defined) then + ! nothing + elseif (par_.EQ.charge .AND. artList_defined) then + write(graphText(zeile),1000) art_Name(artNr) +c elseif (par_.EQ.ener.AND.random_E0) then +c write(graphText(zeile),*) 'Energie= random' +c elseif (par_.EQ.yPos.AND.random_pos) then +c write(graphText(zeile),*) 'Position= random' +c elseif (par_.EQ.zPos.AND.random_pos) then +c ! nothing +c elseif (par_.EQ.thetAng.AND.random_angle) then +c write(graphText(zeile),*) 'Winkel= random' +c elseif (par_.EQ.phiAng.AND.random_angle) then +c ! nothing + elseif ( + + ((par_.EQ.ener).AND.random_E0) .OR. + + ((par_.EQ.yPos.OR.par_.EQ.zPos).AND.random_pos) .OR. + + ((par_.EQ.phiAng.OR.par_.EQ.thetAng).AND.random_angle) )then + write(graphText(zeile),1001) par_text(par_)(1:10), + + parWert(par_),' +ran' + else + write(graphText(zeile),1001) par_text(par_)(1:10), + + parWert(par_) + endif + zeile = zeile+1 + if (zeile.EQ.15) then + write(graphText(zeile)(28:30),'(A3)') '...' + RETURN + endif + enddo + +1000 format (X,' Projektil = ',7X,A) +1001 format (X,' ',A,' = ',F10.3,:A) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE OUTPUT_TABELLEN +c ========================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + integer k + + character*80 varNames,loopZeile,parValues + COMMON /zeilen/ varNames,loopZeile,parValues + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c I. Die speziellen Tabellen: + +c gib die Zeile mit den aktuellen Werte der veraenderlichen Parameter und die +c Statistiken aus: + + if (createTabellen) then + do k = 1, stat_Anzahl + if (createTabelle(k)) then + write(lunPHYSICA+k,'(A)') parValues + write(lunPHYSICA+k,1000) SchleifenNr, + + statMem(6,k),statMem(7,k),statMem(4,k), + + statMem(5,k),int(statMem(8,k)),statMem(9,k) + write(lunPHYSICA+k,'(A)')'_________________________'// + + '_______________________________________________________' + endif + enddo + endif +1000 format(X,I4,4X,F9.2,2X,F7.2,9X,F9.2,X,F9.2,10X,I6,2X,F6.1) +c ^Nr ^mean ^sigma ^von ^bis ^anzahl ^% + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c II. Die PHYSICA - Tabelle: mean, Varianz, min, max, prozent + + if (createPhysTab) then + write(lunPHYSICA,'(X,I6)') SchleifenNr + do k = 1, stat_Anzahl + write(lunPHYSICA,1002)statMem(6,k),statMem(7,k),statMem(4,k), + + statMem(5,k),statMem(9,k) + enddo + endif + +1002 format(X,F15.3,X,F15.3,X,F15.3,X,F15.3,X,F15.3) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE OUTPUT_NEW_PARTICLE +c ============================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + integer startNr ! = absolute Startnummer + + if (OneStartPerLoop) then + startNr = Start_Nr + else + startNr = (SchleifenNr-1)*n_par(0) + Start_nr + endif + + write(lunLOG,*) + write(lunLOG,'(A,I8)') 'Teilchen Nr. ',startNr + if (random_E0) then + write(lunLOG,'(A,F)')'Startenergie : ',parWert(ener) + endif + if (random_angle) then + write(lunLOG,'(A,F)')'Startwinkel (theta): ',parWert(thetAng) + write(lunLOG,'(A,F)')'Startwinkel (phi) : ',parWert(phiAng) + endif + if (random_pos) then + write(lunLOG,'(A,F)')'Startposition (y) : ',parWert(yPos) + write(lunLOG,'(A,F)')'Startposition (z) : ',parWert(zPos) + endif + + + END + + +C=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SUMMARY +c ================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + + real proz ! fuer Umrechnungen in Prozent + + integer k ! Zaehlvariable + integer summe ! fuer Summenbildungen + integer code_,ZahlDestiny + + +1000 format (X,A,:,T49,I6,' (=',F5.1,'%)') ! destiny (gesamt) +1001 format (T5,A, T49,I6,' (=',F5.1,'%)') ! destiny (je Gebiet) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c fuer alle Ausgabekanaele: + + do 3, indx = indx1, indx2 + + if (.NOT.(lun(indx).EQ.lunLog .AND. smallLogFile)) then + + write(lun(indx),'(A)')'- - - - - - - - - - - - - - - - - - '// + + '- - - - - - - - - - - - - - - - - - - - - -' + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + +c die Statistik: +c -------------- + + proz = 100./start_nr + +c - Ausgabe der Teilchenschicksale mit Code-Nummern <= 0: + + do code_ = code_ok, smallest_code_Nr, -1 ! code_ok == 1 + if (code_.EQ.code_ok .OR. statDestiny(code_).NE.0) then + write(lun(indx),*) + write(lun(indx),1000) code_text(code_), + + statDestiny(code_),statDestiny(code_)*proz + endif + enddo + + +c - Ausgabe der Teilchenschicksale mit Code-Nummern > 0: + + do code_ = 1, highest_code_Nr + + !c Teste, ob spezielles Teilchenschicksal ueberhaupt auftrat: + summe = 0 + do Gebiet = 1, Gebiete_Anzahl + summe = summe + + + statDestiny((Gebiet-1)*highest_code_Nr + code_) + enddo + + ! falls ja, gib aus, wie oft Schicksal insgesamt erlitten wurde, + ! und wie oft es in den einzelnen Gebieten erlitten wurde: + if (summe.GT.0) then + write(lun(indx),*) + write(lun(indx),1000) code_text(code_),summe, + + real(summe)*proz + do Gebiet = 1, Gebiete_Anzahl + ZahlDestiny = + + statDestiny((Gebiet-1)*highest_code_Nr+code_) + if (ZahlDestiny.NE.0) then + write(lun(indx),1001) Gebiet_Text(gebiet), + + ZahlDestiny,ZahlDestiny*proz + endif + enddo + endif + enddo + + endif ! if (.NOT.(lun(indx).EQ.lunLog .AND. smallLogFile)) then ... + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ergebnis-Spiegel ausgeben: +c -------------------------- + +2 if (statsInSummary) then + write(lun(indx),*) + write(lun(indx),'(A)') '- - - - - - - - mean - - Varianz'// + + '- - - - - von - - - bis - - - - - Anzahl - - % -' + + do k = 1, stat_Anzahl + if (statInSummary(k)) then + if (statMem(8,k).NE.0) then + write(lun(indx),1006) statName(k),statMem(6,k), + + statMem(7,k),statMem(4,k),statMem(5,k), + + int(statMem(8,k)),statMem(9,k) + else + write(lun(indx),'(x,A9,'':'',T25,A)') + + statName(k),' - - - - - keine Eintraege - - - - -' + endif + endif + enddo + endif + + +1006 format (x,A9,':',T14,F9.2,T26,F7.2,T39,F9.2,T49,F9.2,:,T66,I7, + +T75,F6.1) +c ^% ^mean ^sigma ^von ^bis ^anzahl +c +c sigma(N) = sqrt( ( S(x^2)-((S(x))^2)/n )/n ) +c sigma(N-1) = sqrt( ( S(x^2)-((S(x))^2)/n )/(n-1) ) + + + write(lun(indx),'(A)') '=================================='// + +'==============================================' + +3 continue ! 'fuer alle Ausgabekanaele ...' + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE TERMINATE_OUTPUT +c =========================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + + integer k, iostat + character datum*9,uhrzeit*8 + character zeile*80 + real prozent + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + + prozent = 100./real(start_Nr+(SchleifenNr-1)*n_par(0)) + + call date(datum) + call time(uhrzeit) + if (notLastLoop) then + write(zeile,2000) datum, Uhrzeit, fileName + else + write(zeile,2001) datum, Uhrzeit, fileName + endif +2000 format('Simulation ABGEBROCHEN am ',A9,' um ',A8,T73,A7) +2001 format('Simulation beendet am ',A9,' um ',A8,T73,A7) + + indx = lunScreen +1 continue + + if (dtsmall_counter.GT.0) then + write(indx,1002) dtsmall_counter,dtsmall_counter*prozent + write(indx,1003) n_dtsmall_Max + write(indx,*) + endif + if (Lost_counter.NE.0) then + write(indx,1005) Lost_counter,Lost_counter*prozent + write(indx,*) + endif +1002 format(x,'Bei ',I5,' Trajektorienberechnungen wurde ', + + 'dtsmall unterschritten',T73,'(',F5.1,'%)') +1003 format(x,'(Im Maximalfall wurden ',I6,' Unterschreitungen von', + + ' dtsmall resettet)') +1005 format(x,'wegen steps > maxStep wurden ',I5, + + ' Trajektorienberechnungen abgebrochen',T73,'(',F5.1,'%)') + + write(indx,*) zeile + if (notLastLoop) write(indx,*)' ***********' + write(indx,'(A)')'====================================='// + + '===========================================' + + if ((logFile.OR.smallLogFile) .AND. indx.NE.lunLOG) then + indx = lunLog + goto 1 + endif + + +c das Summary-File und die Tabellen-Files schliessen: + +c - Ausgabe der Geometrie und der Mappencharacteristika: + + if (LogFile.OR.smallLogFile) then + if (debug) then + write(lunLog,'(A)') ' Die Gebietsnummern:' + write(lunLog,*) + do k = 1, Gebiete_Anzahl + write (lunLog,1001) k,Gebiet_Text(k) + enddo + write(lunLog,'(A)')'=============================='// + + '==================================================' + endif + close (lunLog) + endif +1001 format(T4,I3,': ',A) + + do k = 1, Stat_Anzahl + if (createTabelle(k)) close (lunPHYSICA+k) + enddo + + +c das NTP-File schliessen: + + call HROUT(idNTP,iostat,' ') ! NTP in Datei schreiben + call HREND('ACCEL') ! HBOOK-Datei schliessen + close(lunNTP) ! zugehoerige Fortran-Datei schliessen + + +c falls Run im BATCH_MODE laeuft: loesche das '.MESSAGE' file: + + if (BATCH_MODE) then + if (INPUT_LIST) then + open(lunMessage,file='AC_'//inputListName//'MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + else + open(lunMessage,file='ACCEL.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + endif +c "STATUS='DELETE'" entfernt, damit .MESSAGE-Datei von "SUB_LIST.COM" die Nummer +c des zuletzt abgearbeiteten INPUT-Files gelesen werden kann. +c close(lunMessage,status='DELETE',iostat=iostat) + close(lunMessage,iostat=iostat) + endif + + +c zum Abschluss zwei Leerzeilen auf den Bildschirm geben: + + write(*,*) + write(*,*) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_INFOFILE +c ======================== + + IMPLICIT NONE + + INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' + INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' + INCLUDE 'accel$sourcedirectory:COM_GEO.INC' + + character*30 outfile + integer i,j + + character*7 label(par_Anzahl) + DATA label / + + 'U_Tgt_ ','U_Gua_ ','U_G1_ ','B_TD_ ','B_Helm_','Masse_ ','Ladung_', + + 'E0_ ','y0_ ','z0_ ','theta0_','phi0_ ' / + +c------------------------------------------------------------------------------- + + outfile = fileName + +c Gegebenenfalls schreiben des Files mit den E0-Intervallen: + + if (E0InterFromFile) then + open (lunINFO,file=outfile,defaultfile=outDir//':.E0',status='NEW') + do i = 1, nE0Inter + write (lunINFO,1000) 100+i,nint(1000.*E0Low(i)),nint(1000.*E0Low(i+1)),n_par(0) + enddo + close (lunINFO) + endif +1000 format(x,I4,8x,I5,5x,I5,8x,I7) + + +c open INFO file: + + open (lunINFO,file=outfile,defaultfile=outDir//':.INFO',status='NEW') + + +c output information: + + write (lunINFO,*)'========================================'// + + '========================================' + write(lunINFO,*)' This file contains the input parameters used for '//filename + write (lunINFO,*)'========================================'// + + '========================================' + write (lunINFO,*)' The following parameters are the ones relevant for further' + write (lunINFO,*)' calculations by MUTRACK:' + write (lunINFO,*) + write (lunINFO,*) '$acVersion' + write (lunINFO,2600) 'accelVersion',version + write (lunINFO,*) '$END' + write (lunINFO,*) + write (lunINFO,*) '$loop_params' + do j = 1, par_Anzahl + if ((j.EQ.mass.OR.j.EQ.charge).AND.artList_defined) then + ! keine Ausgabe + elseif (j.EQ.UGuard.AND..NOT.freeGuard) then + ! keine Ausgabe + else + write (lunINFO,*) ' ',label(j),' = ',(par(i,j),i=1,3) + endif + enddo + write (lunINFO,*) '$END' + write (lunINFO,*) + write (lunINFO,*) '$additionals' + write (lunINFO,2601) 'par_Anzahl_prevSim',par_Anzahl + write (lunINFO,2610) 'reihenfolge_prevSim',reihenfolge + write (lunINFO,2600) 'mappenNameACCEL',mappenName +2610 format(3x,A,T25,'= ',20(x,I2,:)) + if (artList_defined) write (lunINFO,2601) 'artenZahl_prevSim',n_par(charge) + write (lunINFO,*) '$END' + write (lunINFO,*) + write (lunINFO,*) '$parameter_liste' + write (lunINFO,*) + write (lunINFO,2601) 'Startflaeche',Startflaeche + if (startFlaeche.EQ.-1) write(lunINFO,2602)'x0_',x0(1) + write (lunINFO,*) + if (artList_defined) then + write (lunINFO,2600) 'artList_prevSim',artlist + else + write (lunINFO,*) 'artList_prevSim' + endif + write (lunINFO,2603) 'UseDecay_prevSim',UseDecay + write (lunINFO,*) + write (lunINFO,2601) 'randomStarts_prevSim',n_par(0) + if (random_E0) then + if (random_E0_equal) then + write(lunINFO,2601)'random_energy',1 + if (E0InterFromFile) write (lunINFO,2603) 'E0InterFromFile',E0InterFromFile + write(lunINFO,2602)'lowerE0',lowerE0 + write(lunINFO,2602)'upperE0',upperE0 + elseif (random_E0_gauss) then + write(lunINFO,2601)'random_energy',2 + write(lunINFO,2602)'sigmaE0',sigmaE0 + endif + else + write(lunINFO,2601)'random_energy',0 + endif + if (random_pos) then + if (random_y0z0_equal) then + write(lunINFO,2601)'random_position',1 + write(lunINFO,2602)'StartBreite',StartBreite + write(lunINFO,2602)'StartHoehe',StartHoehe + elseif (random_r0_equal) then + write(lunINFO,2601)'random_position',2 + write(lunINFO,2602)'StartRadius',StartRadius + elseif (random_y0z0_Gauss) then + write(lunINFO,2601)'random_position',3 + write(lunINFO,2602)'StartBreite',StartBreite + write(lunINFO,2602)'StartHoehe',StartHoehe + write(lunINFO,2602)'sigmaPosition',sigmaPosition + elseif (random_r0_Gauss) then + write(lunINFO,2601)'random_position',4 + write(lunINFO,2602)'StartRadius',StartRadius + write(lunINFO,2602)'sigmaPosition',sigmaPosition + endif + else + write(lunINFO,2601)'random_position',0 + endif + if (random_angle) then + if (random_lambert) then + write(lunINFO,2601)'random_winkel',1 + write(lunINFO,2602)'StartLambertOrd',StartLambertOrd + elseif (random_gauss) then + write(lunINFO,2601)'random_winkel',2 + write(lunINFO,2602)'sigmaWinkel',sigmaWinkel + endif + else + write(lunINFO,2601)'random_winkel',0 + endif + write (lunINFO,*) + write (lunINFO,*) '$END' + write (lunINFO,*) + write (lunINFO,*)'========================================'// + + '========================================' + write (lunINFO,*) 'The geometry:' + write (lunINFO,*) 'All x-positions are RELATIVE TO THE CRYOSTAT CENTER,' + write (lunINFO,*) 'All Dy- and Dz-values are HALF OF THE TOTAL SIZE!' + write (lunINFO,*) + write (lunINFO,*) '$geometry' + write (lunINFO,*) + if (scaleFactor.NE.1.) then + write (lunINFO,2500) 'SCALEFACTOR = ', scaleFactor + write (lunINFO,*) ' ! => All data in this file regarding the geometry has to be multiplied' + write (lunINFO,*) ' ! by that factor!' + write (lunINFO,*) + endif + write (lunINFO,2500) 'xFoil = ', xFoil + write (lunINFO,*) + write (lunINFO,2500) 'xEnd_TgtHolder = ', xEnd_TgtHolder + write (lunINFO,2500) 'innerDy1_TgtHolder = ', innerDy1_TgtHolder + write (lunINFO,2500) 'innerDy2_TgtHolder = ', innerDy2_TgtHolder + write (lunINFO,2500) 'outerDy_TgtHolder = ', outerDy_TgtHolder + write (lunINFO,2500) 'innerDz1_TgtHolder = ', innerDz1_TgtHolder + write (lunINFO,2500) 'innerDz2_TgtHolder = ', innerDz2_TgtHolder + write (lunINFO,2500) 'outerDz_TgtHolder = ', outerDz_TgtHolder + write (lunINFO,2500) 'Dy_Foil = ', Dy_Foil + write (lunINFO,2500) 'Dz_Foil = ', Dz_Foil + write (lunINFO,*) + write (lunINFO,2500) 'xStart_Guardring = ', xStart_Guardring + write (lunINFO,2500) 'xEnd_Guardring = ', xEnd_Guardring + write (lunINFO,2500) 'innerDy_Guardring = ', innerDy_Guardring + write (lunINFO,2500) 'outerDy_Guardring = ', outerDy_Guardring + write (lunINFO,2500) 'innerDz_Guardring = ', innerDz_Guardring + write (lunINFO,2500) 'outerDz_Guardring = ', outerDz_Guardring + write (lunINFO,*) + write (lunINFO,2500) 'xPosition_Grid1 = ', xPosition_Grid1 + write (lunINFO,2500) 'distance_wires1 = ', distance_wires1 + write (lunINFO,2500) 'dWires1 = ', dWires1 + write (lunINFO,2500) 'y_Pos_lastWire1 = ', y_Pos_lastWire1 + write (lunINFO,*) + write (lunINFO,2500) 'xStart_Balken = ', xStart_Balken + write (lunINFO,2500) 'xEnd_Balken = ', xEnd_Balken + write (lunINFO,2500) 'Dy_Balken = ', Dy_Balken + write (lunINFO,2500) 'innerDz_Balken = ', innerDz_Balken + write (lunINFO,2500) 'outerDz_Balken = ', outerDz_Balken + write (lunINFO,*) + write (lunINFO,2500) 'xStart_Gridframe1 = ', xStart_Gridframe1 + write (lunINFO,2500) 'xEnd_Gridframe1 = ', xEnd_Gridframe1 + write (lunINFO,2500) 'innerDy_Gridframe1 = ', innerDy_Gridframe1 + write (lunINFO,2500) 'outerDy_Gridframe1 = ', outerDy_Gridframe1 + write (lunINFO,2500) 'innerDz_Gridframe1 = ', innerDz_Gridframe1 + write (lunINFO,2500) 'outerDz_Gridframe1 = ', outerDz_Gridframe1 + write (lunINFO,*) + write (lunINFO,2500) 'xPosition_Grid2 = ', xPosition_Grid2 + write (lunINFO,2500) 'distance_wires2 = ', distance_wires2 + write (lunINFO,2500) 'dWires2 = ', dWires2 + write (lunINFO,2500) 'y_Pos_lastWire2 = ', y_Pos_lastWire2 + write (lunINFO,*) + write (lunINFO,2500) 'xStart_Gridframe2 = ', xStart_Gridframe2 + write (lunINFO,2500) 'xEnd_Gridframe2 = ', xEnd_Gridframe2 + write (lunINFO,2500) 'innerDy_Gridframe2 = ', innerDy_Gridframe2 + write (lunINFO,2500) 'outerDy_Gridframe2 = ', outerDy_Gridframe2 + write (lunINFO,2500) 'innerDz_Gridframe2 = ', innerDz_Gridframe2 + write (lunINFO,2500) 'outerDz_Gridframe2 = ', outerDz_Gridframe2 + write (lunINFO,*) + write (lunINFO,2500) 'rHeShield = ',rHeShield + write (lunINFO,*) + write (lunINFO,*) '$END' + write (lunINFO,*) + if (E0InterFromFile) then + write (lunINFO,*)'========================================'// + + '========================================' + write (lunINFO,*) 'Boundaries of E0-Intervalls:' + do i = 1, nE0Inter+1 + write (lunINFO,'(4x,F8.3)') E0Low(i) + enddo + endif + write (lunINFO,*)'========================================'// + + '========================================' + write (lunINFO,*)' These parameters are just for your information:' + write (lunINFO,*) + write (lunINFO,2600) 'MAPPENNAME',mappenname + write (lunINFO,*) + write (lunINFO,2604) 'eps_x',eps_x + write (lunINFO,2604) 'eps_v',eps_v + write (lunINFO,2603) 'log_relativ',log_relativ + write (lunINFO,2601) 'maxStep',maxStep + write (lunINFO,2602) 'dtsmall',dtsmall + write (lunINFO,2601) 'maxBelowDtSmall',maxBelowDtSmall + write (lunINFO,*) + write (lunINFO,*)' These dimensions of the He window (total size) have been used for graphics' + write (lunINFO,*)' or ''NTP_40mm'' purposes. They are not affecting any further calculations' + write (lunINFO,*)' by MUTRACK.' + write (lunINFO,*) + write (lunINFO,2602) 'dy_HeWindow',2*dy_HeWindow + write (lunINFO,2602) 'dz_HeWindow',2*dz_HeWindow + write (lunINFO,*) + write (lunINFO,*)'========================================'// + + '========================================' + +2600 format(3x,A,T25,'= ':'''',A,'''') ! fuer character +2601 format(3x,A,T25,'= ',4x,I8) ! fuer integer +2602 format(3x,A,T25,'= ',F12.6) ! fuer real +2603 format(3x,A,T25,'= ',L10) ! fuer logical +2604 format(3x,A,T25,'= ',E12.6) ! fuer Exponentdarstellung + + + write (lunINFO,*) +2500 format(T6,A,F8.3) + + +c close INFO file: + + close (lunINFO) + + + END + + +c=============================================================================== diff --git a/accel/src/SUB_PICTURE.FOR b/accel/src/SUB_PICTURE.FOR new file mode 100644 index 0000000..828f5ad --- /dev/null +++ b/accel/src/SUB_PICTURE.FOR @@ -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=============================================================================== diff --git a/mutrack/com/COMPILE.COM b/mutrack/com/COMPILE.COM new file mode 100644 index 0000000..628964b --- /dev/null +++ b/mutrack/com/COMPILE.COM @@ -0,0 +1,28 @@ +$ set noverify +$!============================================================================== +$! Author: Anselm Hofer +$! +$! Commandoprozedur fuer das Compilieren einzelner MUTRACK oder ACCEL-Sourcecode +$! Dateien. Aufzurufen mittels '$ FORMU dateiName' bzw. '$ FORAC dateiName': +$!============================================================================== +$ progr = P1 ! = 'MUTRACK' oder 'ACCEL' +$ ext = P2 ! = '_MU' oder '_AC' +$ file = P3 ! = Name der .FOR-Datei (ohne Extension) +$!============================================================================== +$ file = file - ".FOR" +$ options = "/fast" +$!options = "/align=all" +$!============================================================================== +$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha" +$ if archi .EQS. "VAX" then options = "" +$ if P4 .NES. "" then options = "''options' ''P4'" +$ ext = "''ext'_''archi'" +$ +$ sourceFile = "''progr'$SOURCEdirectory:''file'" +$ objectFile = "''progr'$OBJdirectory:''file'''ext'" +$ listFile = "''progr'$OBJdirectory:''file'''ext'.lis" +$!============================================================================== +$ set verify +$ fortran/extend 'sourceFile' /object='objectFile' 'options' +$ set noverify +$! /list='listFile' diff --git a/mutrack/com/COPY.COM b/mutrack/com/COPY.COM new file mode 100644 index 0000000..f8b41b1 --- /dev/null +++ b/mutrack/com/COPY.COM @@ -0,0 +1,82 @@ +$ set noverify +$!============================================================================== +$! Author: Anselm Hofer +$! +$! Diese Commandoprozedur erlaubt es, die ACCEL- oder MUTRACK-Files +$! "AC_nnn1.'P3'" bis "AC_nnn2.'P3'" (bzw. "MU_nnn1.'P3'" bis "MU_nnn2.'P3'" +$! mit nnn1 = 'P4' und nnn2 = 'P5' auf neue Files zu kopieren, deren +$! fortlaufende Nummer um jeweils 'P6' erhoeht ist. +$! +$! Aufzurufen ueber '$ ACCOPY von bis offset' bzw. '$ MUCOPY von bis offset' +$!============================================================================== +$ if P6.EQS."" +$ then +$ say = "write sys$output " +$ say "===============================================================================" +$ say "ACCOPY extension firstNumber lastNumber offset" +$ say "MUCOPY extension firstNumber lastNumber offset" +$ say "===============================================================================" +$ exit +$ endif +$ progr = P1 ! = 'MUTRACK' oder 'ACCEL' +$ Kuerzel = P2 ! = 'MU_' oder 'AC_' +$ +$ extension = P3 +$ Firstindx = P4 +$ Lastindx = P5 +$ IndxOffset = P6 +$!------------------------------------------------------------------------------ +$ +$ write sys$output " " +$ oldIndx = firstIndx +$ +$ next: +$ newIndx = 0 + oldIndx + indxOffset ! '0 + ' notwendig, damit als Dezimal- +$ ! zahl interpretiert +$! ----------------------------------------------------------------------------- +$ if oldIndx.LT.10 +$ then +$ oldFile = "''progr'$outDirectory:''kuerzel'_000''oldIndx'.''extension'." +$ goto label1 +$ endif +$ if oldIndx.LT.100 +$ then +$ oldFile = "''progr'$outDirectory:''kuerzel'_00''oldIndx'.''extension'." +$ goto label1 +$ endif +$ if oldIndx.LT.1000 +$ then +$ oldFile = "''progr'$outDirectory:''kuerzel'_0''oldIndx'.''extension'." +$ goto label1 +$ endif +$ oldFile = "''progr'$outDirectory:''kuerzel'_''oldIndx'.''extension'." +$! ----------------------------------------------------------------------------- +$ label1: +$ if newIndx.LT.10 +$ then +$ newFile = "''progr'$outDirectory:''kuerzel'_000''newIndx'.''extension'." +$ goto label2 +$ endif +$ if newIndx.LT.100 +$ then +$ newFile = "''progr'$outDirectory:''kuerzel'_00''newIndx'.''extension'." +$ goto label2 +$ endif +$ if newIndx.LT.1000 +$ then +$ newFile = "''progr'$outDirectory:''kuerzel'_0''newIndx'.''extension'." +$ goto label2 +$ endif +$ newFile = "''progr'$outDirectory:''kuerzel'_''newIndx'.''extension'." +$! ----------------------------------------------------------------------------- +$ label2: +$ cop /log 'oldFile' 'newFile' +$ +$ if oldIndx.LT.LastIndx +$ then +$ oldIndx = oldIndx + 1 +$ goto next +$ endif +$ +$ write sys$output " " +$ diff --git a/mutrack/com/FORMUT.COM b/mutrack/com/FORMUT.COM new file mode 100644 index 0000000..da1d385 --- /dev/null +++ b/mutrack/com/FORMUT.COM @@ -0,0 +1,3 @@ +$ set ver +$ fortran 'P1' /obj=mutrack$OBJdirectory:T-'P1' +$ set nover diff --git a/mutrack/com/GETMU.COM b/mutrack/com/GETMU.COM new file mode 100644 index 0000000..2469758 --- /dev/null +++ b/mutrack/com/GETMU.COM @@ -0,0 +1 @@ +copy /log PSICLU::USR_SCROOT:[AHOFER]MU_'P1'.*. mutrack$OUTdirectory:*.*. diff --git a/mutrack/com/GETMUG.COM b/mutrack/com/GETMUG.COM new file mode 100644 index 0000000..2aaf59f --- /dev/null +++ b/mutrack/com/GETMUG.COM @@ -0,0 +1 @@ +copy /log PSICLB::DSA999:[SCR142.GLUECKLER]MU_'p1'.*. mutrack$OUTdirectory:*.*. diff --git a/mutrack/com/GETMUM.COM b/mutrack/com/GETMUM.COM new file mode 100644 index 0000000..fe2a9bd --- /dev/null +++ b/mutrack/com/GETMUM.COM @@ -0,0 +1 @@ +copy /log PSICLB::DSA999:[SCR142.MHEUBERGER]MU_'P1'.*. mutrack$OUTdirectory:*.*. diff --git a/mutrack/com/INIT-MUTEST.COM b/mutrack/com/INIT-MUTEST.COM new file mode 100644 index 0000000..3ab21e7 --- /dev/null +++ b/mutrack/com/INIT-MUTEST.COM @@ -0,0 +1,11 @@ +$! fuer Tests mit zusaetlicher Linse 'NL': +$!============================================================================== +$ DEFINE mutrack$SOURCEdirectory UD1:[SIMULA.MUTRACK.TEST2] +$ FORMUT :== "@mutrack$COMdirectory:formut.com" +$ LINKMUT :== "@mutrack$COMdirectory:linkmut.com" +$ LINKMUTV :== "@mutrack$COMdirectory:linkmutv.com" +$ MU*TRACK :== "RUN mutrack$EXEdirectory:T-MUTRACK.EXE" +$ SUBTMU :== - +"SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory mutrack$COMdirectory:T-MUTRACK.COM" +$ LSEMUT :== "LSE mutrack$READdirectory:mutrackT.input" +$!============================================================================== diff --git a/mutrack/com/LINKMU.COM b/mutrack/com/LINKMU.COM new file mode 100644 index 0000000..ded634d --- /dev/null +++ b/mutrack/com/LINKMU.COM @@ -0,0 +1,33 @@ +$ set noverify +$ set noon +$!============================================================================== +$ prog= "mutrack" +$ ext = "_MU" +$!============================================================================== +$ sourceDir = "''prog'$SOURCEdirectory" +$ objectDir = "''prog'$OBJdirectory" +$ executeDir = "''prog'$EXEdirectory" +$!============================================================================== +$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha" +$ ext = "''ext'_''archi'" +$ set verify +$!============================================================================== +$ link - + 'objectDir':MUTRACK'ext', - + 'objectDir':SUB_ARTLIST'ext', - + 'objectDir':SUB_INTEGR_L1'ext', - + 'objectDir':SUB_INTEGR_SP'ext', - + 'objectDir':SUB_INTEGR_L2andFo'ext', - + 'objectDir':SUB_INTEGR_FO'ext', - + 'objectDir':SUB_INTEGR_L3'ext', - + 'objectDir':SUB_INTEGR_M2'ext', - + 'objectDir':SUB_INPUT'ext', - + 'objectDir':SUB_PICTURE'ext', - + 'objectDir':SUB_OUTPUT'ext',- + 'objectDir':SUB_TRIGGER'ext', - + 'objectDir':SUB_ELOSS'ext', - + 'cernlibs' /exe='executeDir':MUTRACK_'archi' +$ purge 'executeDir':*.EXE +$ set on +$ set noverify +$!============================================================================== diff --git a/mutrack/com/LINKMUD.COM b/mutrack/com/LINKMUD.COM new file mode 100644 index 0000000..528a619 --- /dev/null +++ b/mutrack/com/LINKMUD.COM @@ -0,0 +1,16 @@ +$ set verify +$ link - + mutrack$directory:[exe]MUTRACK, - + mutrack$directory:[exe]SUB_ARTLIST, - + mutrack$directory:[exe]SUB_INTEGR_KL, - + mutrack$directory:[exe]SUB_INTEGR_Sp, - + mutrack$directory:[exe]SUB_INTEGR_FO, - + mutrack$directory:[exe]SUB_INTEGR_WL, - + mutrack$directory:[exe]SUB_INTEGR_M2, - + mutrack$directory:[exe]SUB_INPUT, - + mutrack$directory:[exe]SUB_PICTURE, - + mutrack$directory:[exe]SUB_OUTPUT,- + mutrack$directory:[exe]SUB_TRIGGER, - + 'cernlibs' /debug /exe=mutrack$directory:[exe]MUTRACK +$ purge mutrack$directory:[exe] +$ set noverify diff --git a/mutrack/com/LINKMUT.COM b/mutrack/com/LINKMUT.COM new file mode 100644 index 0000000..37ccc97 --- /dev/null +++ b/mutrack/com/LINKMUT.COM @@ -0,0 +1,18 @@ +$ set verify +$ link - + mutrack$directory:[exe]T-MUTRACK, - + mutrack$directory:[exe]T-SUB_ARTLIST, - + mutrack$directory:[exe]T-SUB_INTEGR_KL, - + mutrack$directory:[exe]T-SUB_INTEGR_Sp, - + mutrack$directory:[exe]T-SUB_INTEGR_NL, - + mutrack$directory:[exe]T-SUB_INTEGR_FO, - + mutrack$directory:[exe]T-SUB_INTEGR_WL, - + mutrack$directory:[exe]T-SUB_INTEGR_M2, - + mutrack$directory:[exe]T-SUB_INPUT, - + mutrack$directory:[exe]T-SUB_PICTURE, - + mutrack$directory:[exe]T-SUB_OUTPUT,- + mutrack$directory:[exe]T-SUB_TRIGGER, - + mutrack$directory:[exe]T-SUB_ELOSS, - + 'cernlibs' /exe=mutrack$directory:[exe]T-MUTRACK +$ purge mutrack$directory:[exe] +$ set noverify diff --git a/mutrack/com/LINKMUTV.COM b/mutrack/com/LINKMUTV.COM new file mode 100644 index 0000000..067c871 --- /dev/null +++ b/mutrack/com/LINKMUTV.COM @@ -0,0 +1,46 @@ +$ set verify +$ set noon +$ fortran mutrack$SOURCEdirectory:MUTRACK - + /object=mutrack$EXEdirectory:T-MUTRACK +$ fortran mutrack$SOURCEdirectory:SUB_ARTLIST - + /object=mutrack$EXEdirectory:T-SUB_ARTLIST +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_KL - + /object=mutrack$EXEdirectory:T-SUB_INTEGR_KL +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_SP - + /object=mutrack$EXEdirectory:T-SUB_INTEGR_SP +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_NL - + /object=mutrack$EXEdirectory:T-SUB_INTEGR_NL +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_FO - + /object=mutrack$EXEdirectory:T-SUB_INTEGR_FO +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_WL - + /object=mutrack$EXEdirectory:T-SUB_INTEGR_WL +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_M2 - + /object=mutrack$EXEdirectory:T-SUB_INTEGR_M2 +$ fortran mutrack$SOURCEdirectory:SUB_INPUT - + /object=mutrack$EXEdirectory:T-SUB_INPUT +$ fortran mutrack$SOURCEdirectory:SUB_PICTURE - + /object=mutrack$EXEdirectory:T-SUB_PICTURE +$ fortran mutrack$SOURCEdirectory:SUB_OUTPUT - + /object=mutrack$EXEdirectory:T-SUB_OUTPUT +$ fortran mutrack$SOURCEdirectory:SUB_TRIGGER - + /object=mutrack$EXEdirectory:T-SUB_TRIGGER +$ fortran mutrack$SOURCEdirectory:SUB_ELOSS - + /object=mutrack$EXEdirectory:T-SUB_ELOSS +$ link - + mutrack$EXEdirectory:T-MUTRACK, - + mutrack$EXEdirectory:T-SUB_ARTLIST, - + mutrack$EXEdirectory:T-SUB_INTEGR_KL, - + mutrack$EXEdirectory:T-SUB_INTEGR_SP, - + mutrack$EXEdirectory:T-SUB_INTEGR_NL, - + mutrack$EXEdirectory:T-SUB_INTEGR_FO, - + mutrack$EXEdirectory:T-SUB_INTEGR_WL, - + mutrack$EXEdirectory:T-SUB_INTEGR_M2, - + mutrack$EXEdirectory:T-SUB_INPUT, - + mutrack$EXEdirectory:T-SUB_PICTURE, - + mutrack$EXEdirectory:T-SUB_OUTPUT,- + mutrack$EXEdirectory:T-SUB_TRIGGER, - + mutrack$EXEdirectory:T-SUB_ELOSS, - + 'cernlibs' /exe=mutrack$EXEdirectory:T-MUTRACK +$ purge mutrack$EXEdirectory +$ set on +$ set noverify diff --git a/mutrack/com/LINKMUV.COM b/mutrack/com/LINKMUV.COM new file mode 100644 index 0000000..f18eb12 --- /dev/null +++ b/mutrack/com/LINKMUV.COM @@ -0,0 +1,82 @@ +$ set noverify +$!============================================================================== +$! Author: Anselm Hofer +$! +$! Commandoprozedur fuer das Compilieren und Linken des kompletten MUTRACK- +$! Quelltextes. Aufzurufen mittels '$ LINKMUV'. ('V' steht fuer 'Vollstaendig'). +$!============================================================================== +$ set noon +$!============================================================================== +$ prog= "mutrack" +$ ext = "_MU" +$!============================================================================== +$ sourceDir = "''prog'$SOURCEdirectory" +$ objectDir = "''prog'$OBJdirectory" +$ executeDir = "''prog'$EXEdirectory" +$!============================================================================== +$ options = "/fast /nolist" +$! options = "/fast /nolist /warn=nogeneral" +$!============================================================================== +$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha" +$ ext = "''ext'_''archi'" +$ if archi .EQS. "VAX" then options = "" +$ if P1 .NES. "" then options = "''options' ''P1'" +$ +$ file = "MUTRACK" +$ CALL compile +$ file = "SUB_ARTLIST +$ CALL compile +$ file = "SUB_INTEGR_L1 +$ CALL compile +$ file = "SUB_INTEGR_SP +$ CALL compile +$ file = "SUB_INTEGR_L2andFo +$ CALL compile +$ file = "SUB_INTEGR_FO +$ CALL compile +$ file = "SUB_INTEGR_L3 +$ CALL compile +$ file = "SUB_INTEGR_M2 +$ CALL compile +$ file = "SUB_INPUT +$ CALL compile +$ file = "SUB_PICTURE +$ CALL compile +$ file = "SUB_OUTPUT +$ CALL compile +$ file = "SUB_TRIGGER +$ CALL compile +$ file = "SUB_ELOSS" +$ CALL compile +$!============================================================================== +$ set verify +$ purge 'objectDir':*.OBJ +$ link - + 'objectDir':MUTRACK'ext', - + 'objectDir':SUB_ARTLIST'ext', - + 'objectDir':SUB_INTEGR_L1'ext', - + 'objectDir':SUB_INTEGR_SP'ext', - + 'objectDir':SUB_INTEGR_L2andFo'ext', - + 'objectDir':SUB_INTEGR_FO'ext', - + 'objectDir':SUB_INTEGR_L3'ext', - + 'objectDir':SUB_INTEGR_M2'ext', - + 'objectDir':SUB_INPUT'ext', - + 'objectDir':SUB_PICTURE'ext', - + 'objectDir':SUB_OUTPUT'ext',- + 'objectDir':SUB_TRIGGER'ext', - + 'objectDir':SUB_ELOSS'ext', - + 'cernlibs' /exe='executeDir':MUTRACK_'archi' +$ purge 'executeDir':*.EXE +$ set on +$ set noverify +$ EXIT +$ +$!============================================================================== +$ +$ COMPILE: SUBROUTINE +$ comp = "fortran ''sourceDir':''file' ''options' /object=''objectDir':''file'''ext'" +$ write sys$output "==============================================================================" +$ write sys$output "''COMP'" +$ comp +$ ENDSUBROUTINE +$!============================================================================== diff --git a/mutrack/com/LINKMUVD.COM b/mutrack/com/LINKMUVD.COM new file mode 100644 index 0000000..4aa75f4 --- /dev/null +++ b/mutrack/com/LINKMUVD.COM @@ -0,0 +1,38 @@ +$ set verify +$ fortran mutrack$SOURCEdirectory:MUTRACK /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_ARTLIST /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_KL /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_SP /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_FO /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_WL /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_M2 /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INPUT /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_PICTURE /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_OUTPUT /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_TRIGGER /warn=nogen - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ link - + mutrack$EXEdirectory:MUTRACK, - + mutrack$EXEdirectory:SUB_ARTLIST, - + mutrack$EXEdirectory:SUB_INTEGR_KL, - + mutrack$EXEdirectory:SUB_INTEGR_SP, - + mutrack$EXEdirectory:SUB_INTEGR_FO, - + mutrack$EXEdirectory:SUB_INTEGR_WL, - + mutrack$EXEdirectory:SUB_INTEGR_M2, - + mutrack$EXEdirectory:SUB_INPUT, - + mutrack$EXEdirectory:SUB_PICTURE, - + mutrack$EXEdirectory:SUB_OUTPUT,- + mutrack$EXEdirectory:SUB_TRIGGER, - + 'cernlibs' /debug /exe=mutrack$EXEdirectory:MUTRACK +$ purge mutrack$EXEdirectory +$ set noverify diff --git a/mutrack/com/LINKMUVVD.COM b/mutrack/com/LINKMUVVD.COM new file mode 100644 index 0000000..3e157d7 --- /dev/null +++ b/mutrack/com/LINKMUVVD.COM @@ -0,0 +1,53 @@ +$ set verify +$ fortran mutrack$SOURCEdirectory:MUTRACK - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_ARTLIST - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_KL - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_SP - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_FO - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_WL - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_M2 - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_INPUT - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_PICTURE - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_OUTPUT - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_TRIGGER - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ fortran mutrack$SOURCEdirectory:SUB_ELOSS - + /warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) - + /check /list /debug /noopt /object=mutrack$EXEdirectory +$ link - + mutrack$EXEdirectory:MUTRACK, - + mutrack$EXEdirectory:SUB_ARTLIST, - + mutrack$EXEdirectory:SUB_INTEGR_KL, - + mutrack$EXEdirectory:SUB_INTEGR_SP, - + mutrack$EXEdirectory:SUB_INTEGR_FO, - + mutrack$EXEdirectory:SUB_INTEGR_WL, - + mutrack$EXEdirectory:SUB_INTEGR_M2, - + mutrack$EXEdirectory:SUB_INPUT, - + mutrack$EXEdirectory:SUB_PICTURE, - + mutrack$EXEdirectory:SUB_OUTPUT,- + mutrack$EXEdirectory:SUB_TRIGGER, - + mutrack$EXEdirectory:SUB_ELOSS, - + 'cernlibs' /debug /exe=mutrack$EXEdirectory:MUTRACK +$ purge mutrack$EXEdirectory +$ set noverify diff --git a/mutrack/com/MAKEWRITELOGOUT.FOR b/mutrack/com/MAKEWRITELOGOUT.FOR new file mode 100644 index 0000000..014e53b --- /dev/null +++ b/mutrack/com/MAKEWRITELOGOUT.FOR @@ -0,0 +1,99 @@ + + OPTIONS /EXTEND_SOURCE + +c PROGRAM WRITELOG +c ================ + +c=============================================================================== +c Dieses Programm uebernimmt aus der Command Zeile eine Runnummer und +c uebertraegt den Header des zugehoerigen Logfiles in WRITELOG_nnnn.OUT. +c (Arbeitet mit 'WRITELOG.COM' zusammen beim ausdrucken von Fileheadern) +c=============================================================================== + + IMPLICIT NONE + +c Deklarationen fuer das Einlesen der Runnummer von der Commandline: + + external cli$get_value + integer cli$get_value + integer status + + character*4 runNumber + integer length + + +c sonstige Deklarationen: + + character*80 zeile + integer i, iostat, marke + logical flag + + +c------------------------------------------------------------------------------- + + +c Lies Runnummer aus Commandline: + + status = cli$get_value('runNumber',runNumber,length) + if (.NOT.status) call lib$signal(%val(status)) + call str$trim(runNumber,runNumber,length) + + +c Oeffne zugehoeriges LOGfile: + + open (20,file='mutrack$OUTdirectory:MU_'//runNumber//'.LOG',status='OLD', + + readonly,iostat=iostat) + + if (iostat.NE.0) then + write(*,*) + write(*,*)'can''t find mutrack$OUTdirectory:MU_'//runNumber//'.LOG' + write(*,*)'-> STOP' + write(*,*) + STOP + endif + + +c Oeffne WRITELOG_nnnn.OUT: + + open (21,file='mutrack$OUTdirectory:WRITELOG_'//runNumber//'.OUT', + + status='NEW') + + +c Uebertrage die Headerzeilen: + +c do i = 1, 130 +c read(20,'(A)',end=20) zeile +c write(21,'(xA)') zeile +c enddo +c write(21,*) +c write(21,*)' >>>>>>>>>> AUSDRUCK HIER ABGEBROCHEN >>>>>>>>>>' + +c - Teste, ob LOGfile mehr als 140 Zeilen hat. Falls ja, drucke nur den +c Haeder. Andernfalls drucke das ganze Logfile + + flag = .false. + marke = -10 + do i = 1, 141 + read(20,'(A)',end=10) zeile + if (index(Zeile,'>>>>> T E S T - R U N <<<<<').NE.0) marke = i + enddo + flag = .true. ! -> nur Headerzeilen schreiben + + +10 rewind(20) + do i = 1, 140 + read(20,'(A)',end=20) zeile + if (flag .AND. index(Zeile,'>>> Schleife :').NE.0) goto 20 + if (i.NE.marke .AND. i.NE.marke+1) then + write(21,'(xA)') zeile + endif + enddo + +c Schliesse die Files: + +20 close (20) + close (21) + + + END + diff --git a/mutrack/com/MAKE_CODENUMMERN-LIST.COM b/mutrack/com/MAKE_CODENUMMERN-LIST.COM new file mode 100644 index 0000000..76b5e2e --- /dev/null +++ b/mutrack/com/MAKE_CODENUMMERN-LIST.COM @@ -0,0 +1,62 @@ +$ set noverify +$!============================================================================== +$! Author: Anselm Hofer +$! +$! Commandoprozedur fuer das Erstellen von Dateien 'CODENUMMERN.LIST', welche +$! die von ACCEL bzw. MUTRACK verwendeten Code-Nummern fuer Integrationsgebiet +$! und Teilchenchicksal erstellen. Diese Dateien werden nach den Directories +$! ACCEL$SOURCEdirectory bzw. MUTRACK$SOURCEdirectory kopiert und koennen von +$! VMS-Ebene oder von PAW aus mittels 'ACCODE' bzw. 'MUCODE' ausgegeben werden. +$! +$! Der Aufruf dieser Prozedur fuer das Erstellen der Dateien geschieht ueber +$! MAKEACCODE / MAKEMUCODE. +$!============================================================================== +$ progr = P1 ! = 'MUTRACK' oder 'ACCEL' +$ ext = P2 ! = '_MU' oder '_AC' +$ flag = P3 ! = 'MAKE' oder 'TYPE' +$!============================================================================== +$ sourceFile = "mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.FOR." +$ objectFile = "''progr'$COMdirectory:MAKE''ext'_CODENUMMERN-LIST.OBJ" +$ exeFile = "''progr'$COMdirectory:MAKE''ext'_CODENUMMERN-LIST.EXE" +$ listFile = "''progr'$SOURCEdirectory:CODENUMMERN.LIST" +$!============================================================================== +$ if p3.EQS."MAKE" then goto make +$ if p3.EQS."TYPE" then goto type +$ if p3.EQS." " then write sys$output "missing parameter P3 (""MAKE"" or ""TYPE"")" +$ write sys$output "unknown parameter P3: ''P3'" +$!============================================================================== +$ MAKE: +$! Compilieren und Linken des Programms fuer den Ausdruck der Liste (muss +$! jedesmal neu gemacht werden, damit die Liste wirklich die aktuellen Code- +$! Nummern enthaelt): +$! +$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha" +$ if archi .EQS. "VAX" then options = " " +$ if archi .EQS. "Alpha" then options = " /ali=all" +$ +$ define MAKE_CODENUMMERN_INCFILE1 "''progr'$SOURCEdirectory:COM_''progr'.INC" +$ define MAKE_CODENUMMERN_INCFILE2 "''progr'$SOURCEdirectory:INITIALIZE.INC" +$ set verify +$ fortran 'sourceFile' /object='objectFile' 'options' +$ link 'objectFile' /exe='exeFile' +$ set noverify +$ +$ del 'objectFile'.* /nocon +$ pu 'exeFile' +$ deassign MAKE_CODENUMMERN_INCFILE1 +$ deassign MAKE_CODENUMMERN_INCFILE2 +$ +$! Erstellen der Liste durch Aufruf des Programms: +$ tmp == F$TRNLNM("''progr'$SOURCEdirectory") +$ define MAKE_CODENUMMERN_OUTDIR "''TMP'" +$ run 'exeFile' +$ deassign MAKE_CODENUMMERN_OUTDIR +$ purge 'listFile' +$ +$ EXIT +$!============================================================================== +$ TYPE: +$! Ausgabe der Liste: +$ TYPE 'listFile' +$ EXIT +$!============================================================================== diff --git a/mutrack/com/MAKE_CODENUMMERN-LIST.FOR b/mutrack/com/MAKE_CODENUMMERN-LIST.FOR new file mode 100644 index 0000000..6109dfe --- /dev/null +++ b/mutrack/com/MAKE_CODENUMMERN-LIST.FOR @@ -0,0 +1,70 @@ + + OPTIONS /EXTEND_SOURCE + + PROGRAM WRITE_CODE_NUMBERS +c ========================== + +c dieses Programm erstellt (nach neuem Kompilieren und Linken) eine jeweils +c aktuelle Liste der verwendeten Codenummern fuer die Gebiete und Teilchen- +c schicksale des Programmes 'MUTRACK' oder 'ACCEL': + + INCLUDE 'MAKE_CODENUMMERN_INCFILE1' + + integer i + character datum*9,uhrzeit*8,helpChar*1 + + INCLUDE 'MAKE_CODENUMMERN_INCFILE2' + + open(20,file='CODENUMMERN.LIST',defaultfile='MAKE_CODENUMMERN_OUTDIR', + + status='NEW',carriagecontrol='LIST') + + call date(datum) + call time(uhrzeit) + + write(20,*)'===============================================================================' + write(20,10) datum,uhrzeit +10 format(' Erstellt am ',A,' um ',A,' durch ''MAKE_CODENUMMERN-LIST.FOR''') + write(20,*) + write(20,*) + write(20,*) ' =========================================================' + write(20,*) ' Die Code-Nummern fuer die verschiedenen Gebiete: ''Gebiet''' + write(20,*) ' =========================================================' + write(20,*) + + write(20,12) 0, 'auf Moderatorfolie' + do i = 1, Gebiete_Anzahl + indx = index(Gebiet_text(i),':') + if (indx.NE.0) then + write(20,11) i, Gebiet_text(i)(1:indx-1) + else + write(20,11) i, Gebiet_text(i) + endif + enddo +11 format(3x,i3,':'6x,A) +12 format(2x'(',i3,':'6x,A,')') + + write(20,*) + write(20,*) + write(20,*) ' ==========================================================' + write(20,*) ' Die Code-Nummern der moeglichen Teilchenschicksale: ''dest''' + write(20,*) ' ==========================================================' + write(20,*) + + do i = smallest_code_Nr, highest_code_Nr + indx = index(code_text(i),':') + if (indx.NE.0) then + write(20,11) i, code_text(i)(1:indx-1) + else + write(20,11) i, code_text(i) + endif + enddo + + write(20,*) + write(20,*)'===============================================================================' + + close(20) + + + END + + diff --git a/mutrack/com/MUTRACK.COM b/mutrack/com/MUTRACK.COM new file mode 100644 index 0000000..e01dd28 --- /dev/null +++ b/mutrack/com/MUTRACK.COM @@ -0,0 +1,8 @@ +$! in case a privious submitted batchjob didn't end properly: +$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE") +$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON +$! run mutrack$EXEdirectory:MUTRACK.EXE +$ MUTRACK +$! in case MUTRACK didn't end properly: +$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE") +$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON diff --git a/mutrack/com/MUTRACK_GENERAL_INIT.COM b/mutrack/com/MUTRACK_GENERAL_INIT.COM new file mode 100644 index 0000000..2cdac85 --- /dev/null +++ b/mutrack/com/MUTRACK_GENERAL_INIT.COM @@ -0,0 +1,36 @@ +$!****************************************************************************** +$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE +$! ARBEIT MIT MUTRACK (ALS BATCH UND INTERAKTIV) +$!****************************************************************************** +$ node = "PSW264" +$ +$ define /trans=con mutrackSRC$directory "UD1:[SIMULA.MUTRACK.] +$ define mutrack$COMdirectory "mutrackSRC$directory:[com]" +$ define mutrack$MAPPENdirectory "UD1:[simula.mappen.mutrack]","UD1:[simula.mappen.testmappen]" +$ define mutrack$AHdirectory "accel$OUTdirectory" +$ define mutrack$GEOdirectory "mutrackSRC$directory:[geo_files]" +$ define mutrack$EXEdirectory "mutrackSRC$directory:[exe]" +$ define mutrack$RDdirectory "mutrackSRC$directory:[RD-kumac]" +$!------------------------------------------------------------------------------ +$ define mutrack$PHYSICASRCdirectory "UD0:[simula.physica_source.mutrack]" +$!============================================================================== +$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha" +$ MU*TRACK :== "RUN mutrack$EXEdirectory:MUTRACK_''archi'.EXE" +$ MUDIR :== "dir mutrack$OUTdirectory:MU*.*.* +$ MULIST :== "dir mutrack$OUTdirectory:MU*.LOG. +$ LSEMU :== "LSE mutrack$READdirectory:MUTRACK.INPUT" +$ LSEMUNR :== "LSE mutrack$NRdirectory:mutrack_nr.dat +$ MUGEO :== "SET DEF UD1:[SIMULA.MUTRACK.GEO_FILES]" +$ MUSTAT :== "@ mutrack$COMdirectory:PLOT_BATCH_STATUS MUTRACK MU TRACK" +$ WRITEMULOG :== "@ mutrack$COMdirectory:WRITELOG.COM" +$ MAKEMUCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM MUTRACK _MU MAKE +$ MUCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM MUTRACK _MU TYPE +$ MUCOPY :== "@ mutrack$COMdirectory:COPY.COM MUTRACK MU" +$!------------------------------------------------------------------------------ +$ SUBMU*TRACK :== - + "SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory mutrack$COMdirectory:MUTRACK.COM +$ SUBMULIST*BATCH :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_BATCH" +$ SUBMULISTF*AST :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_FAST" +$ SUBMULISTS*LOW :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_SLOW" +$ SUBMULISTD*EAD :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_DEAD" +$!============================================================================== diff --git a/mutrack/com/MUTRACK_INIT.COM b/mutrack/com/MUTRACK_INIT.COM new file mode 100644 index 0000000..08d92b2 --- /dev/null +++ b/mutrack/com/MUTRACK_INIT.COM @@ -0,0 +1,12 @@ +$!****************************************************************************** +$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE +$! ARBEIT MIT MUTRACK (ALS BATCH UND INTERAKTIV) +$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN. +$!****************************************************************************** +$ define mutrack$directory "UD1:[simula.mutrack.calc]" +$ define mutrack$READdirectory "mutrack$directory" +$ define mutrack$OUTdirectory "mutrack$directory" +$ define mutrack$NrDirectory "mutrack$directory" +$ MUCALC :== "SET DEF mutrack$directory" +$ MUPH*YS :== "SET DEF UD1:[simula.mutrack.physica]" +$!============================================================================== diff --git a/mutrack/com/MUTRACK_INTER_INIT_OLD.COM b/mutrack/com/MUTRACK_INTER_INIT_OLD.COM new file mode 100644 index 0000000..ee01782 --- /dev/null +++ b/mutrack/com/MUTRACK_INTER_INIT_OLD.COM @@ -0,0 +1,28 @@ +$!****************************************************************************** +$! DIESE KOMMANDOPROZEDUR DEFINIERT SYMBOLS FUER DIE INTERAKTIVE ARBEIT MIT +$! MUTRACK +$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN. +$!****************************************************************************** +$ LSEMU :== "LSE mutrack$READdirectory:mutrack.input +$ MUCALC :== "SET DEF UD1:[SIMULA.MUTRACK.CALC]" +$ MUPH*YS :== "SET DEF UD0:[SIMULA.PHYSICA_SOURCE.MUTRACK]" +$ MUSTAT :== "@ mutrack$COMdirectory:PLOT_BATCH_STATUS.COM MUTRACK MU TRACK" +$ MUGEO :== "SET DEF UD0:[SIMULA.MUTRACK.GEO_FILES]" +$ WRITEMULOG :== "@ mutrack$COMdirectory:WRITELOG.COM" +$!------------------------------------------------------------------------------ +$ SUBMU*TRACK :== - + "SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory mutrack$COMdirectory:MUTRACK.COM" +$ SUBMULIST :== "@ mutrack$COMdirectory:SUB_LIST.COM MU MUTRACK" +$!============================================================================== +$! OBSOLETE: +$ SUBMULIST1 :== - + "SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST1/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST1.COM" +$ SUBMULIST2 :== - + "SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST2/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST2.COM" +$ SUBMULIST3 :== - + "SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST3/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST3.COM" +$ SUBMULIST4 :== - + "SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST4/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST4.COM" +$ SUBMULIST5 :== - + "SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST5/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST5.COM" +$!============================================================================== diff --git a/mutrack/com/MUTRACK_PROGR_INIT.COM b/mutrack/com/MUTRACK_PROGR_INIT.COM new file mode 100644 index 0000000..44757d7 --- /dev/null +++ b/mutrack/com/MUTRACK_PROGR_INIT.COM @@ -0,0 +1,22 @@ +$!****************************************************************************** +$! DIESE KOMMANDOPROZEDUR DEFINIERT LOGICALS UND SYMBOLS FUER DIE PROGRAMMIER- +$! ARBEIT, DAS KOMPILIEREN UND LINKEN VON MUTRACK (INTERAKTIV) +$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN. +$!****************************************************************************** +$ define mutrack$OBJdirectory "mutrackSRC$directory:[EXE]" +$ OLDMU :== "define mutrack$SOURCEdirectory UD1:[SIMULA.MUTRACK.OLD_SOURCE]" +$ NEWMU :== "define mutrack$SOURCEdirectory UD1:[SIMULA.MUTRACK.SOURCE]" +$ NEWMU +$ +$ SETMUTEST :== "SET DEF UD1:[SIMULA.MUTRACK.NEWTEST]" +$ MUPHYSRC :== "SET DEF UD0:[simula.physica_source.mutrack]" +$!------------------------------------------------------------------------------ +$ MUCOM :== "SET DEF UD1:[SIMULA.MUTRACK.COM]" +$ MUSOURCE :== "SET DEF mutrack$SOURCEdirectory" +$ MUMAP :== "SET DEF mutrack$MAPPENdirectory" +$ FORMU :== "@mutrack$COMdirectory:compile.com MUTRACK _MU " +$ LINKMU :== "@mutrack$COMdirectory:linkmu.com" +$ LINKMUV :== "@mutrack$COMdirectory:linkmuv.com" +$ LINKMUD :== "@mutrack$COMdirectory:linkmud.com" +$ LINKMUVD :== "@mutrack$COMdirectory:linkmuvd.com" +$!============================================================================== diff --git a/mutrack/com/PLOT_BATCH_STATUS.COM b/mutrack/com/PLOT_BATCH_STATUS.COM new file mode 100644 index 0000000..5aacd53 --- /dev/null +++ b/mutrack/com/PLOT_BATCH_STATUS.COM @@ -0,0 +1,85 @@ +$ SET NOVERIFY +$! P1 = 'PROGR' = PROGRAMMNAME = "MUTRACK" bzw. "ACCEL" +$! P2 = KUERZEL = "MU" bzw. "AC" +$! P3 = OBTIONALER TEIL DES PROGRAMMAUFRUFES = "TRACK" bzw. "CEL" +$!============================================================================== +$! LAEUFT 'PROGR' ALS BATCHJOB, SO WIRD (BEI MEHR ALS EINER SCHLEIFE) +$! DER AKTUELLE NAME DER AUSGABEDATEIEN SOWIE DIE NUMMER DER GERADE +$! ABGEARBEITETEN SCHLEIFE IN EINER DATEI "''PROGR'.MESSAGE" ABGELEGT. +$! MIT DER VORLIEGENDEN KOMMANDOPROZEDUR WIRD DIESE INFORMATION AUS +$! DER .MESSAGE-DATEI AUSGELESEN UND AUF DEN BILDSCHIRM GEGEBEN. +$! AH, 12-JUN-1996 +$!============================================================================== +$ SET NOVERIFY +$ SET ON +$ SAY := WRITE SYS$OUTPUT +$ SHOW TIME +$ +$ MAXLISTINDX = 20 +$ +$ FLAG = 0 +$ NOTLASTTIME = 1 +$ listIndx = 1 +$ ON ERROR THEN GOTO READERROR +$ +$ LOOP: +$ messageName = "SYS$SCRATCH:''P2'_LIST''listIndx'.MESSAGE" +$ +$ FILEOPEN: +$ OPEN/READ/SHARE=WRITE/ERROR=next messagefile 'messageName' +$ flag = 1 +$ SAY "================================================================================" +$ IF NOTLASTTIME THEN READ messagefile NUMMER +$ READ messagefile TIME1 +$ READ messagefile INPUTNAME +$ READ messagefile FILENAME +$ READ messagefile LOOPINFO +$ READ messagefile TIME2 +$ CLOSE messagefile +$ IF NOTLASTTIME +$ THEN +$ SAY "JOB SUBMITTED WITH ""SUB''P2'LIST ''listIndx'"":" +$ ELSE +$ SAY "JOB SUBMITTED WITH ""SUB''P2'*''P3'"":" +$ ENDIF +$ SAY " NAME OF INPUT FILE : ''INPUTNAME'" +$ IF NOTLASTTIME +$ THEN +$ SAY " (''NUMMER'. file in input_file list,''TIME1')" +$ ELSE +$ SAY " (''TIME1')" +$ ENDIF +$ SAY " NAME OF OUTPUT FILES: ''FILENAME'" +$ LOOPINFO = LOOPINFO-" " +$ SAY " ''LOOPINFO'" +$ SAY " (''TIME2')" +$ GOTO next +$ ! +$ READERROR: +$ SAY "reading ''messageName'" +$ CLOSE messagefile +$ ! +$ NEXT: +$ IF listIndx.LE.maxListIndx +$ THEN +$ listIndx = listIndx + 1 +$ IF listIndx.LE.maxListIndx +$ THEN +$ GOTO LOOP +$ ELSE +$ messageName = "SYS$SCRATCH:''P1'.MESSAGE +$ NOTLASTTIME = 0 +$ GOTO FILEOPEN +$ ENDIF +$ ELSE +$ IF FLAG.EQ.0 +$ THEN +$ SAY " THERE ARE NO APPROPRIATE ''P2'*.MESSAGE-FILES IN SYS$SCRATCH" +$ ELSE +$ SAY "================================================================================" +$ SAY " ( -> SYS$SCRATCH:''P2'*.MESSAGE )" +$ ENDIF +$ ENDIF +$ ! +$ SAY "================================================================================" +$ EXIT diff --git a/mutrack/com/READ-EVENTNRS.FOR b/mutrack/com/READ-EVENTNRS.FOR new file mode 100644 index 0000000..2bd3dfc --- /dev/null +++ b/mutrack/com/READ-EVENTNRS.FOR @@ -0,0 +1,52 @@ + + options /extend_source + + program READ_EVENTNRS +c ===================== + + implicit none + +c------------------------------------------------------------------------------- +c Programm, welches aus dem output eines +c +c $ SEARCH mutrack$outDirectory:MU_nnnn.LOG "MCP2 getroffen" /OUT=SEARCHLIST.TMP +c +c die je Schleife bei einem cut auf MCP2-Treffer in ein NTupel gefuellte +c Anzahl simulierter Events bestimmt. +c------------------------------------------------------------------------------- + + INTEGER LOOP,NEVENT,IEVENT + CHARACTER*80 ZEILE + +c------------------------------------------------------------------------------- + + loop = 0 + nEvent = 0 + iEvent = 1 + + open (10,file='SEARCHLIST.TMP',status='old',readonly) + open (11,file='EVENTNRS.TMP',status='unknown') +10 read(10,'(A)',err=999,end=100) ZEILE + read(zeile(48:54),*,err=1000) nEvent + loop = loop + 1 +c WRITE(*,*) loop,nEvent,iEvent + write(11,*) loop,nEvent,iEvent + iEvent = iEvent+nEvent + goto 10 + +100 close(10) + close(11) + call exit + +999 write(*,*) 'can''t read from SEARCHLIST.TMP' + write(*,*) 'loop,nEvent,iEvent = ',loop,nEvent,iEvent + call exit + +1000 write(*,*) + write(*,*) zeile + write(*,*) zeile(48:54) + + end + + + diff --git a/mutrack/com/SUB_LIST.COM b/mutrack/com/SUB_LIST.COM new file mode 100644 index 0000000..41e69e7 --- /dev/null +++ b/mutrack/com/SUB_LIST.COM @@ -0,0 +1,82 @@ +$!============================================================================== +$! KOMMANDOPROZEDUR FUER DAS SUBMITTEN VON 'INPUTFILE-LISTEN' VON MUTRACK UND +$! ACCEL MITTELS 'SUBMULISTn' BZW. 'SUBACLISTn'. +$!============================================================================== +$! 1. LOESCHE GEGEBENENFALLS DAS .MESSAGE FILE +$! 2. IN DER SCHLEIFE: VERSUCHE DAS .MESSAGE-FILE ZU OEFFNEN +$! 3. GELINGT DIES NICHT, SO WURDE DIE KOMMANDOPROZEDUR GERADE ERST GESTARTET. +$! EIN PROGRAMMDURCHLAUF WIRD DANN AUF JEDEN FALL PORBIERT. +$! 4. LIES BEI NEUEM VERSUCH ERST DIE NUMMER DES ZULETZT ABGEARBEITETEN INPUT- +$! FILES. IST DIESE = 1, SO LOESCHE DAS .MESSAGE FILE UND BEENDE PROZEDUR +$!============================================================================== +$! P1 = KUERZEL DES PROGRAMMES = "MU" bzw. "AC" +$! P2 = PROGRAMMAUFRUF = "MUTRACK" bzw. "ACCEL" +$! P3 = QUEUE +$! P4 = NUMMER DER INPUTLISTE (WAHRSCHEINLICH AUF 1-9 EINGESCHRAENKT) +$! P5 = QUEUE-ENTRY, AUF DEN SYNCHRONISIERT WERDEN SOLL +$!============================================================================== +$! Definition der Filenamen: +$ INPUTLISTNAME = "LIST''P4'" +$ COMFILENAME = "SYS$SCRATCH:'P1'_LIST'P4'.COM" +$ MESSFILENAME = "SYS$SCRATCH:''P1'_LIST''P4'.MESSAGE" +$! +$! Oeffnen des files fuer die zu submittende Kommandoprozedur: +$ FILE = F$SEARCH("''COMFILENAME'") +$ IF FILE .NES. "" THEN DELETE 'COMFILENAME'.* /NOCON +$ OPEN /WRITE comfile 'COMFILENAME' +$ OUT := WRITE COMFILE +$! +$! Erstellen der zu submittenden Kommandoprozedur: +$ OUT "$! DIESE KOMMANDOPROZEDUR WURDE DURCH 'SUB_LIST.COM' ERSTELLT UND WIRD +$ OUT "$! NUR TEMPORAER BENOETIGT, BIS DER DURCH ""$ SUB''P1'LIST ''P4'"" GESTARTETE +$ OUT "$! BATCHJOB ABGEARBEITET IST. BEI NORMALEM ENDE DES BATCHJOBS WIRD DIESES +$ OUT "$! FILE ZUM SCHLUSS GELOESCHT!" +$ OUT "$!============================================================================= +$ OUT "$ SET NOON +$ OUT "$! +$ IF P5 .NES. "" +$ THEN +$ OUT "$ SYNCHRONIZE /ENTRY = ''P5' +$ OUT "$! +$ ENDIF +$ OUT "$ DEFINE/NOLOG INPUTLISTNAME ''INPUTLISTNAME'" +$ OUT "$! in case a privious submitted batchjob didn't end properly: +$ OUT "$ FILE = F$SEARCH(""''MESSFILENAME'"") +$ OUT "$ IF FILE .NES. """" THEN DELETE ''MESSFILENAME'.* /NOCON +$ OUT "$! +$ OUT "$ FIRSTTIME = ""TRUE"" +$ OUT "$ LOOP_START: +$ OUT "$ OPEN /SHARE /READ /ERROR=OPEN_ERROR messagefile ''MESSFILENAME' +$ OUT "$ READ messagefile FILENR +$ OUT "$ CLOSE messagefile +$ OUT "$ IF (FILENR.EQ.1) THEN GOTO FINISH +$ OUT "$! +$ OUT "$ PROG_CALL: +$ OUT "$ ''P2' +$ OUT "$ GOTO LOOP_START +$ OUT "$! +$ OUT "$ FINISH: +$ OUT "$ FILE = F$SEARCH(""''MESSFILENAME'"") +$ OUT "$ IF FILE .NES. """" THEN DELETE ''MESSFILENAME'.* /NOCON +$ OUT "$ WRITE SYS$OUTPUT ""''P1'_LIST''P4' FINISHED PROPERLY"" +$ OUT "$ EXIT +$ OUT "$! +$ OUT "$!------------------------------------------------------------------------------ +$ OUT "$ OPEN_ERROR: +$ OUT "$ IF (FIRSTTIME.EQS.""TRUE"") +$ OUT "$ THEN +$ OUT "$ FIRSTTIME = ""FALSE"" +$ OUT "$ GOTO PROG_CALL +$ OUT "$ ELSE +$ OUT "$! in spite of the program has already been run there is no .MESSAGE file +$ OUT "$! => all input files have already been done => exit +$ OUT "$ GOTO FINISH +$ OUT "$ ENDIF +$ OUT "$!------------------------------------------------------------------------------ +$ CLOSE COMFILE +$! +$! Submitten der Kommandoprozedur: +$ SUBMIT/DELETE/NOTIFY/NOPRINT/QUEUE='P3'/NAME='P1'LIST'P4' - + /LOG_FILE='P2'$OUTdirectory 'COMFILENAME' +$! +$ EXIT diff --git a/mutrack/com/SUB_MUTRACK.COM b/mutrack/com/SUB_MUTRACK.COM new file mode 100644 index 0000000..aed3520 --- /dev/null +++ b/mutrack/com/SUB_MUTRACK.COM @@ -0,0 +1,3 @@ +$ IF P1.NES."" THEN SYNCHRONIZE /ENTRY = ''P1' +$ SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory - + mutrack$COMdirectory:MUTRACK.COM" diff --git a/mutrack/com/T-MUTRACK.COM b/mutrack/com/T-MUTRACK.COM new file mode 100644 index 0000000..b40acc3 --- /dev/null +++ b/mutrack/com/T-MUTRACK.COM @@ -0,0 +1,7 @@ +$! in case a privious submitted batchjob didn't end properly: +$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE") +$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON +$ run mutrack$EXEdirectory:T-MUTRACK.EXE +$! in case MUTRACK didn't end properly: +$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE") +$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON diff --git a/mutrack/com/WRITELOG.COM b/mutrack/com/WRITELOG.COM new file mode 100644 index 0000000..f80f422 --- /dev/null +++ b/mutrack/com/WRITELOG.COM @@ -0,0 +1,49 @@ +$! KOMMANDOPROZEDUR FUER DEN AUSDRUCK DER HEADERZEILEN VON 'MU_nnnn.LOG'-Dateien +$! ============================================================================= +$! +$ SET NOON +$ SET NOVERIFY +$ SAY := WRITE SYS$OUTPUT +$ SET COMMAND mutrack$COMdirectory:DEF_MAKEWRITELOGOUT.CLD +$ ! FILE MIT HEADERZEILEN ERSTELLEN LASSEN: +$ IF P1 .EQS. "" +$ THEN +$ SAY "%WRITELOG: error: NO RUN NUMBER GIVEN IN COMMANDLINE" +$ EXIT +$ ENDIF +$ IF P1 .EQS. "?" +$ THEN +$ SAY " " +$ SAY " WRITEMULOG runNr [destinaton]" +$ SAY " " +$ SAY " destination not specified -> output to screen" +$ SAY " " +$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (have to be given in upper case!)" +$ SAY " " +$ EXIT +$ ENDIF +$ IF (P2.NES."PSW04" .AND. P2.NES."PSW23" .AND. P2.NES."PRL" .AND. P2.NES."PRL2" .AND. P2.NES."") +$ THEN +$ SAY " " +$ SAY " ""''P2'"" is not an accepted destination!" +$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (UPPER CASE ONLY!)" +$ SAY " " +$ EXIT +$ ENDIF +$! +$ MAKEWRITELOGOUT "''P1'" +$ OUTFILENAME = "MUTRACK$OUTdirectory:WRITELOG_" + "''P1'" + ".OUT;" +$ say "''outfilename'" +$ IF P2 .EQS. "" +$ THEN +$ TY 'OUTFILENAME' +$ DELETE /NOCON 'OUTFILENAME' +$ WRITE SYS$OUTPUT "================================================================================" +$ EXIT +$ ENDIF +$ IF (P2.EQS."PRL" .OR. P2.EQS."PRL2") +$ THEN +$ PRL2 'OUTFILENAME' /del +$ EXIT +$ ENDIF +$ VPP 'OUTFILENAME' /delete /dev=printer /form=listq /dest= "''P2'" diff --git a/mutrack/geo_files/GEO_KAMMER_RUN10.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN10.INPUT new file mode 100644 index 0000000..04f6750 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN10.INPUT @@ -0,0 +1,144 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! mit Schleussenkammer + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 2.0 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 11.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 48.0 ! Breite + dzgrid1 = 48.0 ! Hoehe + dist_wires_G1 = 1.0 ! Drahtabstand + dWires_G1 = 0.025 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 48.0 ! Breite + dzgrid2 = 48.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.025 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 47.25 ! Radius + dyHeShield = 45.0 ! Breite des Fensters + dzHeShield = 45.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 52.75 ! Radius + dyLNShield = 45.0 ! Breite des Fensters + dzLNShield = 45.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 499.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + ! Linse 2: + + xCenterOfLense_L2 = 322 ! Position der Linsenmitte (1/2 Stutzten) + MappenName_L2andFo= 'L2andFo' ! Name der Potentialmappe + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + xTD = 545.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + xCenterOfLense_L3 = 913.0 ! Linsenmitte (913.0alt) + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + ! mit Schleussenkammer 161.0 (1328.35 alt) + + xMCP2 = 1489.35 ! Position (incl. Reduzier- + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe + + $END + +c=============================================================================== + +die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm): +============================================================================ + + $trigger_grids + + dist_Wires_V1 = 1.500 + dWires_V1 = 0.025 + + dist_Wires_V2 = 1.500 + dWires_V2 = 0.025 + + dist_Wires_V3 = 1.500 + dWires_V3 = 0.025 + + dist_Wires_H1 = 1.500 + dWires_H1 = 0.025 + + dist_Wires_H2 = 1.500 + dWires_H2 = 0.025 + + dist_Wires_G = 1.500 + dWires_G = 0.025 + + $END + diff --git a/mutrack/geo_files/GEO_KAMMER_RUN11_RUN12.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN11_RUN12.INPUT new file mode 100644 index 0000000..a8d8a62 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN11_RUN12.INPUT @@ -0,0 +1,194 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! mit Schleussenkammer + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 2.0 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 12.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 48.0 ! Breite + dzgrid1 = 48.0 ! Hoehe + dist_wires_G1 = 1.0 ! Drahtabstand + dWires_G1 = 0.025 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 22.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 48.0 ! Breite + dzgrid2 = 48.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.025 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 47.25 ! Radius + dyHeShield = 40.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 52.75 ! Radius + dyLNShield = 40.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 499.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + ! Linse 2: + + xCenterOfLense_L2 = 267.0 ! Position der Linsenmitte der neuen L2 + ! Elektroden 50.0 (0V) 60.0 (HV) 100.0 (0V) + ! Elektrodenabstaende 12.0 + MappenName_L2andFo= 'L2andFo' ! es existiert keine Potentialmappe + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + xTD = 586.0 ! Aufhaengung des TDs == Mitte + ! Abstand bis auf Folie 534.0 + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3 + + xCenterOfLense_L3 = 1111.0 ! Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! alter MCP2: + + xMCP2 = 1688.0 ! Position MCP + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe + + ! neuer MCP2: + + xMCP2 = 1698.0 ! Position MCP + radius_MCP2active = 23.0 ????? ! Radius der aktiven Flaeche + ! es existiert keine Mappe + + + ! + ! fuer nachfolgende Teile existieren keine Feldmappen + ! + ! Ringanode ungesplittet + ! vordere Position bei 1623.0 + ! HV Elektrode + ! vorderer Durchmesser: 66.8 + ! hinterer Durchmesser: 116.0 + ! gerade Laenge : 90.0 + ! Neigungswinkel : 16 grad + ! 0V Elektrode + ! Abstand zu HV Elektrode: 12.0 + ! Durchmesser : 116.0 + ! Laenge : 116.0 + + ! Probenplatte Kryostat: + ! nachfolgende Masse beziehen sich auf die Montage des Saphirs mit D = 6.0mm + ! wird der Saphir nicht verwendet, muessen die Positionen entsprechend korrigiert + ! werden + ! 1696.0 + ! Probenoberflaeche je nach Probendicke bei 1694.0 bis 1696.0 + ! Durchmesser Probenplatte: 70.0 mm + ! Befestigungsring Probe : 1694 bis 1692 (hat eine Dicke von 2.0, Abstand haengt + ! von Probendicke ab) + ! Oeffnungsdurchmesser : 40.0 oder 45.0 mm + ! Aussendurchmesser : 70.0 mm + ! Guardringe + ! Innendurchmesser : 58.0 mm + ! Aussendurchmesser : 70.0 mm + ! Dicke : 3.0 mm + ! Abstand Guard1 zu + ! Probenbefestigungsring : 13.0 mm !oder zu Probenplatte bei s-RG Messungen + ! Abstand Guard2 zu + ! Probenbefestigungsring : 29.0 mm + ! Abstand Erdungsgitter Kuehlschild + ! zu Probenbefestigungsring : 48.0 mm !Anstand von Probenplatte aus gemessen + ! Anstand Erdungsgitter Kuehlschild - Guardringen bzw. Probenoberflaechen haengt von + ! Probendicke ab. + ! Position Kuehlplatte (0V) : 1706.0 + ! Durchmesser : 70.0 mm + ! Position Kuehlfinger : 1711.0 + ! Durchmesser : 55.0 mm + + + $END + +c=============================================================================== + +die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm): +============================================================================ + + $trigger_grids + + dist_Wires_V1 = 1.500 + dWires_V1 = 0.025 + + dist_Wires_V2 = 1.500 + dWires_V2 = 0.025 + + dist_Wires_V3 = 1.500 + dWires_V3 = 0.025 + + dist_Wires_H1 = 1.500 + dWires_H1 = 0.025 + + dist_Wires_H2 = 1.500 + dWires_H2 = 0.025 + + dist_Wires_G = 1.500 + dWires_G = 0.025 + + $END + diff --git a/mutrack/geo_files/GEO_KAMMER_RUN11_RUN12_FOR_ELOSS.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN11_RUN12_FOR_ELOSS.INPUT new file mode 100644 index 0000000..82ebfa5 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN11_RUN12_FOR_ELOSS.INPUT @@ -0,0 +1,202 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c +c nov-dec 1999 EM+HG NOT FINAL: modified to analyse ELOSS data of run12 +c xcenterODLense_L2 use old value 322. instead of new 267. +c xTD use old value 545. instead of 586. +c otherwise mutrack has run time error +c potential map of L2 still for old (run10) dimensions +c ring anode not included +c +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! mit Schleussenkammer + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 2.0 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 12.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 48.0 ! Breite + dzgrid1 = 48.0 ! Hoehe + dist_wires_G1 = 1.0 ! Drahtabstand + dWires_G1 = 0.025 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 22.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 48.0 ! Breite + dzgrid2 = 48.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.025 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 47.25 ! Radius + dyHeShield = 40.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 52.75 ! Radius + dyLNShield = 40.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 499.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + ! Linse 2: + + xCenterOfLense_L2 = 322. ! should be 267.0 ! Position der Linsenmitte der neuen L2 + ! Elektroden 50.0 (0V) 60.0 (HV) 100.0 (0V) + ! Elektrodenabstaende 12.0 + MappenName_L2andFo= 'L2andFo' ! es existiert keine Potentialmappe + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + xTD = 545. ! should be 586.0 ! Aufhaengung des TDs == Mitte + ! Abstand bis auf Folie 534.0 + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3 + + xCenterOfLense_L3 = 1111.0 ! Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! alter MCP2: + + xMCP2 = 1688.0 ! Position MCP + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe + + ! neuer MCP2: + + xMCP2 = 1698.0 ! Position MCP + radius_MCP2active = 23.0 ????? ! Radius der aktiven Flaeche + ! es existiert keine Mappe + + + ! + ! fuer nachfolgende Teile existieren keine Feldmappen + ! + ! Ringanode ungesplittet + ! vordere Position bei 1623.0 + ! HV Elektrode + ! vorderer Durchmesser: 66.8 + ! hinterer Durchmesser: 116.0 + ! gerade Laenge : 90.0 + ! Neigungswinkel : 16 grad + ! 0V Elektrode + ! Abstand zu HV Elektrode: 12.0 + ! Durchmesser : 116.0 + ! Laenge : 116.0 + + ! Probenplatte Kryostat: + ! nachfolgende Masse beziehen sich auf die Montage des Saphirs mit D = 6.0mm + ! wird der Saphir nicht verwendet, muessen die Positionen entsprechend korrigiert + ! werden + ! 1696.0 + ! Probenoberflaeche je nach Probendicke bei 1694.0 bis 1696.0 + ! Durchmesser Probenplatte: 70.0 mm + ! Befestigungsring Probe : 1694 bis 1692 (hat eine Dicke von 2.0, Abstand haengt + ! von Probendicke ab) + ! Oeffnungsdurchmesser : 40.0 oder 45.0 mm + ! Aussendurchmesser : 70.0 mm + ! Guardringe + ! Innendurchmesser : 58.0 mm + ! Aussendurchmesser : 70.0 mm + ! Dicke : 3.0 mm + ! Abstand Guard1 zu + ! Probenbefestigungsring : 13.0 mm !oder zu Probenplatte bei s-RG Messungen + ! Abstand Guard2 zu + ! Probenbefestigungsring : 29.0 mm + ! Abstand Erdungsgitter Kuehlschild + ! zu Probenbefestigungsring : 48.0 mm !Anstand von Probenplatte aus gemessen + ! Anstand Erdungsgitter Kuehlschild - Guardringen bzw. Probenoberflaechen haengt von + ! Probendicke ab. + ! Position Kuehlplatte (0V) : 1706.0 + ! Durchmesser : 70.0 mm + ! Position Kuehlfinger : 1711.0 + ! Durchmesser : 55.0 mm + + + $END + +c=============================================================================== + +die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm): +============================================================================ + + $trigger_grids + + dist_Wires_V1 = 1.500 + dWires_V1 = 0.025 + + dist_Wires_V2 = 1.500 + dWires_V2 = 0.025 + + dist_Wires_V3 = 1.500 + dWires_V3 = 0.025 + + dist_Wires_H1 = 1.500 + dWires_H1 = 0.025 + + dist_Wires_H2 = 1.500 + dWires_H2 = 0.025 + + dist_Wires_G = 1.500 + dWires_G = 0.025 + + $END + diff --git a/mutrack/geo_files/GEO_KAMMER_RUN2.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN2.INPUT new file mode 100644 index 0000000..28db2de --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN2.INPUT @@ -0,0 +1,109 @@ +c=============================================================================== +c GEO_KAMMER_run2.INPUT +c +c vgl.: LB. 2, S. 78 - 80 (mittlerer Arm entfernt) +c LB. 6, S. 113 +c LB. EM A2, S. 39 - 41 +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = -6.5 ! Position RELATIV ZUM KRYO + dytarget = 24.0 ! Breite + dztarget = 16.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius vom Schild + dyHeShield = 28.0 ! Breite + dzHeShield = 20.0 ! Hoehe + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 28.0 ! Breite + dzLNShield = 20.0 ! Hoehe + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 477.0 ! Position + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 0.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.0 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + ! Linse 3: + + xCenterOfLense_L3 = 225.0 ! Position der Linsenmitte + MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe + + + ! MCP2: + + xMCP2 = 524.0 ! Position + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP_run2' ! Name der Potentialmappe + + $END + +c=============================================================================== + +=> Gesamtlaenge zwischen Target und MCP2 front: 6.5 + 477 + 524 = 1007.5 + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN3-4.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN3-4.INPUT new file mode 100644 index 0000000..4c144b2 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN3-4.INPUT @@ -0,0 +1,109 @@ +c=============================================================================== +c GEO_KAMMER_RUN3-4.INPUT +c +c EM: 22.2.96 Abstaende fuer Runs 3 und 4 +c (kein TriggerDetektor, Tgt-Dimensionen = 24 x 16 mm^2) +c Abstaende aus LB EM A2/p45. Siehe auch LB8/p203,LB9/p3 +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = -6.5 ! Position RELATIV ZUM KRYO + dytarget = 24.0 ! Breite + dztarget = 16.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius vom Schild + dyHeShield = 28.0 ! Breite + dzHeShield = 20.0 ! Hoehe + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 28.0 ! Breite + dzLNShield = 20.0 ! Hoehe + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 477.0 ! Position + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 0.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.0 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + ! Linse 3: + + xCenterOfLense_L3 = 384.0 ! Position der Linsenmitte + MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe + + + ! MCP2: + + xMCP2 = 772.35 ! Position + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'M2_1' ! Name der Potentialmappe + + $END + +c=============================================================================== + +=> Gesamtlaenge zwischen Target und MCP2 front: 6.5 + 477 + 772.35 = 1255.85 + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN6-8.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN6-8.INPUT new file mode 100644 index 0000000..24cebd8 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN6-8.INPUT @@ -0,0 +1,115 @@ + +c=============================================================================== +c GEO_KAMMER_run6-8.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 477.0 ! Position + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 0.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.0 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: + + xTD = 372.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: + + xCenterOfLense_L3 = 714.0 ! Position der Linsenmitte + MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe + + + ! MCP2: + + xMCP2 = 1102.35 ! Position + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'M2_1' ! Name der Potentialmappe + + $END + +c=============================================================================== + +=> Gesamtlaenge zwischen Target und MCP2 front: -3.5 + 477 + 1102.35 = 1575.85 + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN7_LONG.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN7_LONG.INPUT new file mode 100644 index 0000000..a01ef94 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN7_LONG.INPUT @@ -0,0 +1,118 @@ + +c=============================================================================== +c GEO_KAMMER_run7_LONG.INPUT +c=============================================================================== + +Dieses File enthaelt die Kammergeometrie waehrend run 7 mit Rohrverlaengerung +zur Messung des Energieverlustes der Myonen in der TD-Folie + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 477.0 ! Position + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 0.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.0 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: + + xTD = 372.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: + + xCenterOfLense_L3 = 714.0 ! Position der Linsenmitte + MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe + + + ! MCP2: + + xMCP2 = 1537.35 ! Position + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'M2_1' ! Name der Potentialmappe + + $END + +c=============================================================================== + +=> Gesamtlaenge zwischen Target und MCP2 front: -3.5 + 477 + 1537.35 = 2010.85 + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN9.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN9.INPUT new file mode 100644 index 0000000..825e96f --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN9.INPUT @@ -0,0 +1,113 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 499.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + xTD = 545.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + + xMCP2 = 1328.35 ! Position (incl. Reduzier- + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe + + $END + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN9_NEW.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW.INPUT new file mode 100644 index 0000000..b2228b8 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW.INPUT @@ -0,0 +1,113 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 499.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + xTD = 545.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + + xMCP2 = 1328.35 ! Position (incl. Reduzier- + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe + + $END + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_MUONS.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_MUONS.INPUT new file mode 100644 index 0000000..ce2ab40 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_MUONS.INPUT @@ -0,0 +1,139 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + ! Der Zeitnullpunkt fuer M2S1 ab Run 1097 wurde auf 1803.3 festgelegt, der- + ! jenige fuer M3S1 auf 1788.1. Um bei diesen Werten optimale Uebereinstimmung + ! zwischen simulierten und experimentellen Peakpositionen in M3S1 und M2S1 zu + ! erhalten mussten die Flugstrecken FUER MYONEN zwischen Target und Trigger- + ! detektor um 7.5 mm sowie zwischen Target und MCP2 um 4.9 mm gegenueber den + ! urspruenglich verwendeten Werten verlaengert werden. Die Flugstrecke zwischen + ! Triggerdetektor und MCP2 wurde also um 2.6 mm verkuerzt. + ! + ! Die entsprechenden Flugstreckenaenderungen FUER PROTONEN betragen 6.0 mm + ! fuer M3S1 und 4.8 mm fuer M2S1 (=> -1.2 mm fuer M3M2). + ! + ! Diese Datei enthaelt die resultierenden Werte fuer die Myonen: + ! Eingefuegt wurden: + ! + ! +2.5 mm zwischen Tgt und L1 + ! +2.5 mm zwischen L1 und Spiegel + ! +2.5 mm zwischen Spiegel und TD + ! -1.3 mm zwischen TD und L3 -2.3 + ! -1.3 mm zwischen L3 und MCP2 -0.3 + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + ! xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + xCenterOfLense_L1 = 252.5 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + ! xSpiegel = 499.0 ! Position (=477.0 + 22.0) + xSpiegel = 504.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + ! xTD = 545.0 ! Aufhaengung des TDs == Mitte + xTD = 547.5 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + ! xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte + ! xCenterOfLense_L3 = 914.2 ! Position der Linsenmitte + xCenterOfLense_L3 = 913.2 ! Position der Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + + ! xMCP2 = 1328.35 ! Position (incl. Reduzier- + xMCP2 = 1328.25 ! Position (incl. Reduzier- + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe + + $END + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS.INPUT new file mode 100644 index 0000000..802013d --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS.INPUT @@ -0,0 +1,148 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + ! Der Zeitnullpunkt fuer M2S1 ab Run 1097 wurde auf 1803.3 festgelegt, der- + ! jenige fuer M3S1 auf 1788.1. Um bei diesen Werten optimale Uebereinstimmung + ! zwischen simulierten und experimentellen Peakpositionen in M3S1 und M2S1 zu + ! erhalten mussten die Flugstrecken FUER PROTONEN zwischen Target und Trigger- + ! detektor um 6.0 mm sowie zwischen Target und MCP2 um 4.8 mm gegenueber den + ! urspruenglich verwendeten Werten verlaengert werden. Die Flugstrecke zwischen + ! Triggerdetektor und MCP2 wurde also um 1.2 mm verkuerzt. + ! + ! Die entsprechenden Flugstreckenaenderungen FUER MYONEN betragen 7.5 mm + ! fuer M3S1 und 4.9 mm fuer M2S1 (=> -2.6 mm fuer M3M2). + ! + ! Diese Datei enthaelt die resultierenden Werte fuer die Protonen: + ! Eingefuegt wurden: + ! + ! +2.0 mm zwischen Tgt und L1 + ! +2.0 mm zwischen L1 und Spiegel + ! +2.0 mm zwischen Spiegel und TD + ! -0.6 mm zwischen TD und L3 -2.3 + ! -0.6 mm zwischen L3 und MCP2 -0.3 + + ! Wegen Meldung + ! "Potentialmappen von Linse 3 und MCP2 ueberlappen! + ! Dies ist in der aktuellen Implementierung des Programmes + ! nicht vorgesehen!" + ! musste die L3-Mappe anschliessend um 3 mm zum TD hin verschoben werden, um + ! den Ueberlapp wieder zu aufzuheben! + + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + ! xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + xCenterOfLense_L1 = 252.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + ! xSpiegel = 499.0 ! Position (=477.0 + 22.0) + xSpiegel = 503.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + ! xTD = 545.0 ! Aufhaengung des TDs == Mitte + xTD = 547.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + ! xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte + ! xCenterOfLense_L3 = 914.4 ! Position der Linsenmitte + xCenterOfLense_L3 = 914.1 ! Position der Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + + ! xMCP2 = 1328.35 ! Position (incl. Reduzier- + ! xMCP2 = 1328.15 ! Position (incl. Reduzier- + xMCP2 = 1329.15 ! Position (incl. Reduzier- + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe + + $END + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS_OLD.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS_OLD.INPUT new file mode 100644 index 0000000..4e14689 --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN9_NEW_PROTONS_OLD.INPUT @@ -0,0 +1,138 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! + !============================================================================== + + ! Der Zeitnullpunkt fuer M2S1 ab Run 1097 wurde auf 1803.3 festgelegt, der- + ! jenige fuer M3S1 auf 1788.1. Um bei diesen Werten optimale Uebereinstimmung + ! zwischen simulierten und experimentellen Peakpositionen in M3S1 und M2S1 zu + ! erhalten mussten die Flugstrecken FUER PROTONEN zwischen Target und Trigger- + ! detektor um 6.0 mm sowie zwischen Target und MCP2 um 4.8 mm gegenueber den + ! urspruenglich verwendeten Werten verlaengert werden. Die Flugstrecke zwischen + ! Triggerdetektor und MCP2 wurde also um 1.2 mm verkuerzt. + ! + ! Die entsprechenden Flugstreckenaenderungen FUER MYONEN betragen 7.5 mm + ! fuer M3S1 und 4.9 mm fuer M2S1 (=> -2.6 mm fuer M3M2). + ! + ! Diese Datei enthaelt die resultierenden Werte fuer die Protonen: + ! Eingefuegt wurden: + ! + ! +2.0 mm zwischen Tgt und L1 + ! +2.0 mm zwischen L1 und Spiegel + ! +2.0 mm zwischen Spiegel und TD + ! -1.1 mm zwischen TD und L3 -2.3 + ! -1.1 mm zwischen L3 und MCP2 -0.3 + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 3.5 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 32.0 ! Breite + dzgrid1 = 32.0 ! Hoehe + dist_wires_G1 = 0.5 ! Drahtabstand + dWires_G1 = 0.050 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 42.0 ! Breite + dzgrid2 = 42.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.050 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 38.5 ! Radius + dyHeShield = 36.0 ! Breite des Fensters + dzHeShield = 36.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 45.5 ! Radius + dyLNShield = 36.0 ! Breite des Fensters + dzLNShield = 36.0 ! Hoehe des Fensters + + + ! Linse 1: + + ! xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + xCenterOfLense_L1 = 252.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + ! xSpiegel = 499.0 ! Position (=477.0 + 22.0) + xSpiegel = 503.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + ! xTD = 545.0 ! Aufhaengung des TDs == Mitte + xTD = 547.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + ! xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte + xCenterOfLense_L3 = 913.9 ! Position der Linsenmitte + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + + ! xMCP2 = 1328.35 ! Position (incl. Reduzier- + xMCP2 = 1328.15 ! Position (incl. Reduzier- + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 20.0 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe + + $END + +c=============================================================================== diff --git a/mutrack/geo_files/GEO_KAMMER_RUN_SAMPLE10.INPUT b/mutrack/geo_files/GEO_KAMMER_RUN_SAMPLE10.INPUT new file mode 100644 index 0000000..071b44b --- /dev/null +++ b/mutrack/geo_files/GEO_KAMMER_RUN_SAMPLE10.INPUT @@ -0,0 +1,144 @@ +c=============================================================================== +c GEO_KAMMER.INPUT +c=============================================================================== + + $kammer_geo + + + !============================================================================== + ! 'HORIZONTALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse) + ! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite + ! der Moderatorfolie, also 'xTarget' gemessen werden) + ! mit Schleussenkammer + !============================================================================== + + + ! Vakuumrohr: + + radius_Rohr = 75. + + + ! Target: + + xtarget = 2.0 ! Position RELATIV ZUM KRYO + dytarget = 30.0 ! Breite + dztarget = 30.0 ! Hoehe + + + ! erstes Beschleunigungsgitter: + + xgrid1 = 11.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid1 = 48.0 ! Breite + dzgrid1 = 48.0 ! Hoehe + dist_wires_G1 = 1.0 ! Drahtabstand + dWires_G1 = 0.025 ! Drahtdurchmesser + + + ! zweites Beschleunigungsgitter: + + xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR + dygrid2 = 48.0 ! Breite + dzgrid2 = 48.0 ! Hoehe + dist_wires_G2 = 1.0 ! Drahtabstand + dWires_G2 = 0.025 ! Drahtdurchmesser + + + ! He-Schild: + + rHeShield = 47.25 ! Radius + dyHeShield = 45.0 ! Breite des Fensters + dzHeShield = 45.0 ! Hoehe des Fensters + + + ! LN-Schild: + + rLNShield = 52.75 ! Radius + dyLNShield = 45.0 ! Breite des Fensters + dzLNShield = 45.0 ! Hoehe des Fensters + + + ! Linse 1: + + xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte + MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe + + + ! Spiegel: + + xSpiegel = 499.0 ! Position (=477.0 + 22.0) + MappenName_Sp = 'mirror' ! Name der Potentialmappe + + DreharmLaenge = 11.0 ! horizont. Abstand zwischen + ! Aufhaengung und Spiegelmitte + BSpiegel = 114.0 ! Breite + hSpiegel = 100.0 ! Hoehe + DSpiegel = 22.5 ! Tiefe + dist_wires_Sp = 1.0 ! Drahtabstand + dWires_Sp = 0.050 ! Drahtdurchmesser + + + !============================================================================== + ! 'VERTIKALER' KAMMERTEIL + ! + ! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel- + ! aufhaengung gemessen! + !============================================================================== + + ! Linse 2: + + xCenterOfLense_L2 = 322 ! Position der Linsenmitte (1/2 Stutzten) + MappenName_L2andFo= 'L2andFo' ! Name der Potentialmappe + + ! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296 + + xTD = 545.0 ! Aufhaengung des TDs == Mitte + mappenName_Fo = 'FO_1' ! des Doppelkreuzes + + + ! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220 + ! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE. + + xCenterOfLense_L3 = 913.0 ! Linsenmitte (913.0alt) + MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe + + + ! MCP2:alt 1102.35, Abstand zu Flansch: 170.85 + ! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm. + ! mit Schleussenkammer 161.0 (1328.35 alt) + + xMCP2 = 1506 ! Probenposition im Kryo + ! ! flansch mit Dicke 24.5 mm) + radius_MCP2active = 22.5 ! Radius der aktiven Flaeche + MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe + + $END + +c=============================================================================== + +die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm): +============================================================================ + + $trigger_grids + + dist_Wires_V1 = 1.500 + dWires_V1 = 0.025 + + dist_Wires_V2 = 1.500 + dWires_V2 = 0.025 + + dist_Wires_V3 = 1.500 + dWires_V3 = 0.025 + + dist_Wires_H1 = 1.500 + dWires_H1 = 0.025 + + dist_Wires_H2 = 1.500 + dWires_H2 = 0.025 + + dist_Wires_G = 1.500 + dWires_G = 0.025 + + $END + diff --git a/mutrack/src/CODENUMMERN.LIST b/mutrack/src/CODENUMMERN.LIST new file mode 100644 index 0000000..ee267fb --- /dev/null +++ b/mutrack/src/CODENUMMERN.LIST @@ -0,0 +1,52 @@ + =============================================================================== + Erstellt am 17-JAN-99 um 17:51:38 durch 'MAKE_CODENUMMERN-LIST.FOR' + + + ========================================================= + Die Code-Nummern fuer die verschiedenen Gebiete: 'Gebiet' + ========================================================= + + ( 0: auf Moderatorfolie) + 1: in 1. Beschl.Stufe + 2: in 2. Beschl.Stufe + 3: bis He-Schild + 4: bis LN-Schild + 5: vor Linse-1-Mappe + 6: in Linse-1-Mappe + 7: bis Spiegel + 8: im Spiegel + 9: bis Koordinatenwechsel + 10: vor Linse-2-Mappe + 11: in Linse-2-Mappe + 12: bis TriggerDetektor + 13: im TriggerDetektor + 14: vor Linse-3-Mappe + 15: in Linse-3-Mappe + 16: zwischen Linse-3-Mappe und MCP2-Mappe + 17: vor MCP2 + + + ========================================================== + Die Code-Nummern der moeglichen Teilchenschicksale: 'dest' + ========================================================== + + -10: in Triggerfolie gestoppt + -9: Targethalter getroffen + -8: ACCEL + -7: ACCEL + -6: auf Rand des MCP2 + -5: auf Blende des MCP2 + -4: von MCP3 nicht registriert + -3: im TD abgebrochen + -2: Folienstuetzgitter getr. + -1: Spiegel durchquert + 0: MCP2 getroffen + 1: zerfallen + 2: Element verfehlt + 3: reflektiert + 4: auf Gitter getroffen + 5: aufgeschlagen + 6: verloren (steps>maxsteps) + 7: Zeitschritt kleiner dtSmall + + =============================================================================== diff --git a/mutrack/src/COM_DIRS.INC b/mutrack/src/COM_DIRS.INC new file mode 100644 index 0000000..06a99fe --- /dev/null +++ b/mutrack/src/COM_DIRS.INC @@ -0,0 +1,16 @@ +c------------------------------------------------------------------------------- +c Die verwendeten Directories +c------------------------------------------------------------------------------- + + character*(*) MappenDir,TP_Dir,ACCEL_Dir,readDir,outDir,NrDir + character*(*) TMPDIR,geoDIR + + parameter (MappenDir = 'mutrack$mappenDirectory' ) + parameter (TP_Dir = 'mutrack$TPdirectory' ) + parameter (ACCEL_Dir = 'mutrack$AHdirectory' ) + parameter (readDir = 'mutrack$READdirectory' ) + parameter (geoDir = 'mutrack$GEOdirectory' ) + parameter (outDir = 'mutrack$OUTdirectory' ) + parameter (NrDir = 'mutrack$NrDirectory' ) + parameter (TMPDir = 'SYS$SCRATCH' ) + diff --git a/mutrack/src/COM_KAMMER.INC b/mutrack/src/COM_KAMMER.INC new file mode 100644 index 0000000..c9a48be --- /dev/null +++ b/mutrack/src/COM_KAMMER.INC @@ -0,0 +1,224 @@ +c=============================================================================== +c COM_KAMMER.INC +c=============================================================================== + +c Veraenderungen in diesem File sind nur mit angemessener Vorsicht vorzunehmen! +c Die Groessen, die sich auf Bereiche beziehen, in denen mittels Potentialmappen +c integriert wird (und die in anderen COMMON-Bloecken als dem 'blank'-Block +c stehen) werden in den include files 'MAP_DEF_xx.INC' nochmals mit anderen +c Bezeichnungen definiert (ohne die Extensionen '_L1','_L2','_L3','_FO' und '_M2'). +c Auch sind die dort definierten COMMON-Bloecke umfassender als die hier +c angegebenen Teilbereiche. Daher muessen Aenderungen in dem vorliegenden File +c im Regelfall von entsprechenden Aenderungen in diesen Files begleitet werden! + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Vakuumrohr: + + real radius_Rohr ! Radius + +c Target: + + real xtarget ! Position + real dytarget ! Breite + real dztarget ! Hoehe + +c erstes Beschleunigungsgitter: + + real xgrid1 ! Position + real dygrid1 ! Breite + real dzgrid1 ! Hoehe + real dWires_G1 ! Drahtdurchmesser + real dist_Wires_G1 ! Drahtabstand + +c zweites Beschleunigungsgitter: + + real xgrid2 ! Position + real dygrid2 ! Breite + real dzgrid2 ! Hoehe + real dWires_G2 ! Drahtdurchmesser + real dist_Wires_G2 ! Drahtabstand + +c He-Schild: + + real rHeShield ! Radius + real dyHeShield ! Breite + real dzHeShield ! Hoehe + +c LN-Schild: + + real rLNShield ! Radius + real dyLNShield ! Breite + real dzLNShield ! Hoehe + +c Linse 1: + + real Beschl_Faktor_L1 + COMMON /Beschl_Faktor_L1/ Beschl_Faktor_L1 + + character*40 MappenName_L1 /' '/ + real dl_max_L1 + + COMMON /integration_L1/ MappenName_L1,dl_max_L1 + + real xCenterOfLense_L1 + real xEnterMap_L1 + real xLeaveMap_L1 + + COMMON /integration_L1/ xCenterOfLense_L1,xEnterMap_L1,xLeaveMap_L1 + + real DistanceCyl_L1 + real iRadiusCyl_L1 + real LengthOuterCyl_L1 + real oRadiusOuterCyl_L1 + real LengthInnerCyl_L1 + real oRadiusInnerCyl_L1 + real RadiusVacTube_L1 + + COMMON /integration_L1/ DistanceCyl_L1,iRadiusCyl_L1 + COMMON /integration_L1/ LengthOuterCyl_L1,oRadiusOuterCyl_L1 + COMMON /integration_L1/ LengthInnerCyl_L1,oRadiusInnerCyl_L1 + COMMON /integration_L1/ RadiusVacTube_L1 + +c Spiegel: + + real Beschl_Faktor_Sp + COMMON /Beschl_Faktor_Sp/ Beschl_Faktor_Sp + + character*40 MappenName_Sp /' '/ + real dl_max_Sp + + COMMON /integration_Sp/ MappenName_Sp,dl_max_Sp + + real xSpGrid1,xSpGrid2 ! Gitterpositionen innerhalb der Mappe [mm] + real DSpiegel ! Abstand der Spiegelgitter + real dWires_Sp ! Drahtdurchmesser + real dist_Wires_Sp ! Drahtabstand + + COMMON /integration_Sp/ xSpGrid1,xSpGrid2,DSpiegel, + * dWires_Sp,dist_Wires_Sp + + real xmin_Sp_1,xmax_Sp_1 + real xmin_Sp_2,xmax_Sp_2 + real xmin_Sp_3,xmax_Sp_3 + + COMMON /integration_SP_1/ xmin_Sp_1,xmax_Sp_1 + COMMON /integration_SP_2/ xmin_Sp_2,xmax_Sp_2 + COMMON /integration_SP_3/ xmin_Sp_3,xmax_Sp_3 + + real xSpiegel ! Position + real DreharmLaenge ! horizontaler Abstand zwischen Spielgel- + ! aufhaengung und Spiegelmittelpkt. + real BSpiegel ! Breite + real hSpiegel ! Hoehe + +c Linse 2: + + character*40 MappenName_L2andFo /' '/ + real dl_max_L2andFo + + COMMON /integration_L2andFo/ MappenName_L2andFo,dl_max_L2andFo + + real xCenterOfLense_L2,xEndLense_L2 + real xEnterMap_L2andFo + real xLeaveMap_L2andFo + + COMMON /integration_L2andFo/ xCenterOfLense_L2,xEndLense_L2, + + xEnterMap_L2andFo,xLeaveMap_L2andFo + + real DistanceCyl_L2 + real iRadiusCyl_L2 + real LengthOuterCyl_L2 + real oRadiusOuterCyl_L2 + real LengthInnerCyl_L2 + real oRadiusInnerCyl_L2 + real RadiusVacTube_L2 + + COMMON /integration_L2andFo/ DistanceCyl_L2,iRadiusCyl_L2 + COMMON /integration_L2andFo/ LengthOuterCyl_L2,oRadiusOuterCyl_L2 + COMMON /integration_L2andFo/ LengthInnerCyl_L2,oRadiusInnerCyl_L2 + COMMON /integration_L2andFo/ RadiusVacTube_L2 + + +c Triggerdetektor: + + real Beschl_Faktor_Fo + COMMON /Beschl_Faktor_Fo/ Beschl_Faktor_Fo + + character*40 MappenName_Fo /' '/ + real dl_max_Fo + + real MappenLaenge_Fo + real xEnterMap_Fo + + COMMON /integration_Fo/ MappenName_Fo,dl_max_Fo + COMMON /integration_Fo/ MappenLaenge_Fo,xEnterMap_Fo + + real xTD,TransTDFoil + + +c Linse 3: + + real Beschl_Faktor_L3 + COMMON /Beschl_Faktor_L3/ Beschl_Faktor_L3 + + character*40 MappenName_L3 /' '/ + real dl_max_L3 + + COMMON /integration_L3/ MappenName_L3,dl_max_L3 + + real xCenterOfLense_L3 + real xEnterMap_L3 + real xLeaveMap_L3 + + COMMON /integration_L3/ xCenterOfLense_L3,xEnterMap_L3,xLeaveMap_L3 + + real DistanceCyl_L3 + real iRadiusCyl_L3 + real LengthOuterCyl_L3 + real oRadiusOuterCyl_L3 + real LengthInnerCyl_L3 + real oRadiusInnerCyl_L3 + real RadiusVacTube_L3 + + COMMON /integration_L3/ DistanceCyl_L3,iRadiusCyl_L3 + COMMON /integration_L3/ LengthOuterCyl_L3,oRadiusOuterCyl_L3 + COMMON /integration_L3/ LengthInnerCyl_L3,oRadiusInnerCyl_L3 + COMMON /integration_L3/ RadiusVacTube_L3 + +c MCP2: + + real Beschl_Faktor_M2 + COMMON /Beschl_Faktor_M2/ Beschl_Faktor_M2 + + character*40 MappenName_M2 /' '/ + real dl_max_M2 + + COMMON /integration_M2/ MappenName_M2,dl_max_M2 + + real xMCP2 + real xEnterMap_M2 + real radius_MCP2 ! Radius des MCP2 + + COMMON /integration_M2/ xMCP2,xEnterMap_M2,radius_MCP2 + + + real radius_MCP2active ! Radius der aktiven Flaeche des MCP2 + real xBlende ! Position der Blende + real radius_Blende ! Radius der Blende + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + COMMON /KAMMER_GEO/ + + radius_Rohr, + + xtarget,dytarget,dztarget, + + xgrid1,dygrid1,dzgrid1,dWires_G1,dist_Wires_G1, + + xgrid2,dygrid2,dzgrid2,dWires_G2,dist_Wires_G2, + + rHeShield,dyHeShield,dzHeShield, + + rLNShield,dyLNShield,dzLNShield, + + xSpiegel,DreharmLaenge,BSpiegel,hSpiegel, + + xTD,TransTDFoil, + + radius_MCP2active, + + xBlende,radius_Blende + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/mutrack/src/COM_LUNS.INC b/mutrack/src/COM_LUNS.INC new file mode 100644 index 0000000..f3c9bc0 --- /dev/null +++ b/mutrack/src/COM_LUNS.INC @@ -0,0 +1,23 @@ +c=============================================================================== +c COM_LUNS.INC +c=============================================================================== + +c Dieses file legt die von 'MUTRACK' benutzten logischen Einheiten fuer Ein- und +c Ausgabe fest: + + integer lunREAD, lunScreen, lunLOG, lunNTP, luNPHYSICA + integer lunTMP, lunFOIL, lunMESSAGE + + parameter ( lunREAD = 17 ) + parameter ( lunScreen = 6 ) + parameter ( lunLOG = 18 ) + parameter ( lunNTP = 19 ) + parameter ( lunPHYSICA = 20 ) + parameter ( lunTMP = 16 ) + parameter ( lunFOIL = 15 ) + parameter ( lunMESSAGE = 14 ) + + +c Die Tabellenfiles werden entsprechend ihrer Nummer den Ausgabeeinheiten +c (lunPHYSICA + 1) bis (lunPHYSICA + stat_Anzahl) zugeeordnet. + diff --git a/mutrack/src/COM_MUTRACK.INC b/mutrack/src/COM_MUTRACK.INC new file mode 100644 index 0000000..aed83a0 --- /dev/null +++ b/mutrack/src/COM_MUTRACK.INC @@ -0,0 +1,768 @@ +c=============================================================================== +c COM_MUTRACK.INC +c=============================================================================== +c +c Dieses Includefile enthaelt die Deklarationen der meisten Variablen, die +c innerhalb des Programms Mutrack von mehr als einer Routine benoetigt werden +c und daher einem Commonblock zugeordnet sein muessen. Fuer diese Variablen +c wird der unbenannte ('blank') Commonblock verwendet. Dieses file wird in +c fast alle Subroutinen eingebunden (abgesehen von denen, die in der Datei +c SUB_TD.FOR zusammengefasst sind und sich auf die Trajektorienberechnung im +c Bereich des TriggerDetektors beschraenken). +c +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + +c=============================================================================== +c I. Konstanten +c=============================================================================== + +c------------------------------------------------------------------------------- +c Die Versionsnummern +c------------------------------------------------------------------------------- + + character*8 version ! Versionsnummer von MUTRACK + parameter ( version = '2.0.1' ) + +c=============================================================================== + + character*8 accelVersion /' '/ ! Versionsnummer von ACCEL + integer accelVersionIndx + character*25 mappenNameACCEL + + character*8 mutrackVersion /' '/ ! Versionsnummer von 'FoilFile' + integer mutrackVersionIndx + + COMMON accelVersion,accelVersionIndx,mutrackVersion,mutrackVersionIndx + COMMON mappenNameACCEL + +c=============================================================================== +c Ver. 1.4.1: mit richtiger Formel fuer SigmaAufstreu: +c (ausgehend von 'theta1/2 = HWHM' anstatt wie zuvor '.. = FWHM') +c +c Ver. 1.5.1: - Implementierung der neuen Linse 'L2' zwischen Spiegel und TD. +c - Alle Programmstellen in Zusammenhang mit Simulationsfiles +c von TP wurden entfernt. In der Praxis wurde die Moeglichkeit +c nie genutzt und erschwerte bei der Programmpflege die Programmier- +c arbeit. In der Folge wurde auch das logical 'USE_AH' ueber- +c fluessig. Die diesbezgl. Steuerung erfolgt jetzt nur noch +c ueber 'fromScratch', 'use_ACCEL' und 'use_MUTRACK'. +c - Umbenennung einiger Variabler. Speziell wurde die Extension +c '_AH' von Variablen in Zusammenhang mit ACCEL und 'foilfile' +c durch '_prevSim' (fuer PREVious SIMulation) ersetzt. +c - Vorbereitung der Implementierung der Magnetfelder durch Ein- +c fuehren der entsprechenden Schleifenparameter etc. Bis jetzt aber +c ohne jegliche Magnetfeldspezifische Kalkulationen. +c Ver. 1.5.2: - neues Logical 'alfaTgtVertically' +c Ver. 1.5.3: - Fehlerbereinigung: Ab Version 1.5.1 wurden bei Fortfuehrung von +c Foilfiles, welche selbst aus ACCEL-files erzeugt worden sind +c die Trajektoriendaten statt aus dem Foilfile aus dem ACCEL-file +c eingelesen. Auch wurde die Gebietskodierung nicht aktualiesiert +c Ver. 1.5.4: - 27-jan-1997 (AH): 'sigmaS1Fo' und 'smearS1Fo' implementiert +c Ver. 1.5.5: - 02-feb-1997 (AH): implementation of 'E0InterFromFile' +c Ver. 1.5.6: - praktisch gleich Ver. 1.5.5 +c Ver. 2.0.0: - mit f-Funktion von Meyer als bessere Winkelaufstreuungs- +c verteilungsfunktion gegenueber bisher verwendeter Gauss- +c foermiger Winkelaufstreuung. +c - Wahlmoeglichkeit zwischen ICRU-Energieverlustdaten fuer +c Graphit (bisher ausschliesslich verwendet) und amorphen +c Kohlenstoff (mit etwas kleinerem mittleren Energieverlust) +c implementiert. (-> logical 'graphitData'). (Es werden wie +c zuvor stets die totalen Stoppingpowerdaten, also elektronisch +c + nuklear, verwendet). +c - Routinen fuer Berechnung der Breite der Energieaufstreuung in +c der Triggerfolie nach Lindhard/Scharff (theoret.) sowie nach +c Yang (semiempirisch) implementiert. Die Routinen beruhen auf +c den (sehr kurzen) Programmen, mit welchen ich die Kurven +c fuer die Diss erstellt habe. Jedoch habe ich nicht mehr aus- +c getestet, ob ich bei der Abaenderung fuer Mutrack alles richtig +c gemacht habe ... +c - Version 2.0.0 ist die letzte von mir erstellte Version. +c Ich hoffe, alles ist mittlerweile einigermassen fehlerfrei und +c ausreichend verstaendlich, so dass die Nachwelt sich bei +c anfaelligen Aenderungen nicht ueber Gebuehr echauffieren muss... +c Gruss, Anselm Hofer ... +c +c - Version 2.0.1: nTuple output contains now position +c information of muons at TD foil as well as +c the position of FE when hitting MCP3 +c TP, 18-Oct-2000 +c +c=============================================================================== + +c------------------------------------------------------------------------------- +c Zuteilung der GebietsNummern k (0 <= k <= Gebiete_Anzahl) +c zu den Gebieten +c------------------------------------------------------------------------------- + + integer target,upToGrid1,upToGrid2,upToHeShield, + + upToLNShield,upToL1Map,upToExL1,upToEnSp,upToExSp, + + upToChKoord,upToL2andFoMap,upToExL2,upToEnTD,upToExTD, + + upToL3Map,upToExL3,upToM2Map,upToMCP2 + +c GEBIET 'k' + parameter ( target = 0 ) ! <- zaehlt nicht fuer 'Gebiete_Anzahl'! + parameter ( upToGrid1 = 1 ) + parameter ( upToGrid2 = 2 ) + parameter ( upToHeShield = 3 ) + parameter ( upToLNShield = 4 ) + parameter ( upToL1Map = 5 ) + parameter ( upToExL1 = 6 ) + parameter ( upToEnSp = 7 ) + parameter ( upToExSp = 8 ) + parameter ( upToChKoord = 9 ) + parameter ( upToL2andFoMap = 10 ) + parameter ( upToExL2 = 11 ) + parameter ( upToEnTD = 12 ) + parameter ( upToExTD = 13 ) + parameter ( upToL3Map = 14 ) + parameter ( upToExL3 = 15 ) + parameter ( upToM2Map = 16 ) + parameter ( upToMCP2 = 17 ) + + integer Gebiete_Anzahl + parameter ( Gebiete_Anzahl=17) ! <- Startpkt 'Target' zaehlt nicht !! + + character Gebiet_Text(Gebiete_Anzahl)*40 + COMMON Gebiet_Text + + +c------------------------------------------------------------------------------- +c Zuteilungen der Schleifenparameter zu den Feldelemenkten k +c (1 <= k <= par_Anzahl) von par(i,k), n_par(k), parWert(k), par_text(k) +c------------------------------------------------------------------------------- + + integer UTgt,UGua,UG1,UL1,USp,UL2,UL3, UFolie,UVorne,UHinten,UMCP3, + + UMCP2, BTD,BHelm, alfTgt,alfSp,alfTD, mass,charge, + + ener,yPos,zPos,thetAng,phiAng,Thickn,Eloss,DeltaL1,DeltaL2 + + parameter ( UTgt = 1 ) + parameter ( UGua = 2 ) + parameter ( UG1 = 3 ) + parameter ( UL1 = 4 ) + parameter ( USp = 5 ) + parameter ( UL2 = 6 ) + parameter ( UL3 = 7 ) + + parameter ( UFolie = 8 ) + parameter ( UVorne = 9 ) + parameter ( UHinten = 10 ) + parameter ( UMCP3 = 11 ) + + parameter ( UMCP2 = 12 ) + + parameter ( BTD = 13 ) + parameter ( BHelm = 14 ) + + parameter ( alfTgt = 15 ) + parameter ( alfSp = 16 ) + parameter ( alfTD = 17 ) + + parameter ( mass = 18 ) + parameter ( charge = 19 ) + + parameter ( ener = 20 ) + parameter ( yPos = 21 ) + parameter ( zPos = 22 ) + parameter ( thetAng = 23 ) + parameter ( phiAng = 24 ) + + parameter ( Thickn = 25 ) + parameter ( Eloss = 26 ) + + parameter ( DeltaL1 = 27 ) + parameter ( DeltaL2 = 28 ) + + integer par_Anzahl + parameter ( par_Anzahl=28) ! <- 'Zufalls-Schleife' zu k=0 zaehlt nicht! + + +c------------------------------------------------------------------------------- +c Code-Nummern fuer das Schicksal des Teilchens +c------------------------------------------------------------------------------- + + integer smallest_code_Nr + integer highest_code_Nr + + integer code_stopped_in_foil + integer code_durchSpiegel,code_Stuetzgitter,code_lostInTD,code_NotRegInM3 + integer code_hitBlende,code_hitMCP2inactive + integer code_frontOfMapAc,code_leftMapAc,code_hit_TgtHolder + integer code_ok + integer code_decay,code_vorbei,code_reflektiert, + + code_wand,code_grid,code_lost,code_dtsmall + +c SCHICKSAL 'code' + + parameter ( smallest_code_Nr =-10 ) + + parameter ( code_ok = 0 ) + parameter ( code_durchSpiegel = -1 ) + parameter ( code_Stuetzgitter = -2 ) + parameter ( code_lostInTD = -3 ) + parameter ( code_NotRegInM3 = -4 ) + parameter ( code_hitBlende = -5 ) + parameter ( code_hitMCP2inactive= -6 ) + + parameter ( code_frontOfMapAc = -7 ) + parameter ( code_leftMapAc = -8 ) + parameter ( code_hit_TgtHolder = -9 ) + + parameter ( code_stopped_in_foil=-10 ) + + parameter ( code_decay = 1 ) + parameter ( code_vorbei = 2 ) + parameter ( code_reflektiert = 3 ) + parameter ( code_grid = 4 ) + parameter ( code_wand = 5 ) + parameter ( code_lost = 6 ) + parameter ( code_dtsmall = 7 ) + + parameter ( highest_code_Nr = 7 ) + + character code_Text(smallest_code_Nr:highest_code_Nr)*27 + COMMON code_text + + +c------------------------------------------------------------------------------- +c Zuteilung der Statistiken zu den Feldelementen k ( 1<= k <= stat_Anzahl) +c von statInMemory(k),createTabelle(k),statNeeded(k),statMem(i,k) +c------------------------------------------------------------------------------- + + integer Nr_S1xM2,Nr_S1M2,Nr_S1Fo,Nr_FoM2,Nr_S1M3,Nr_M3M2,Nr_t_FE, + + Nr_y_Fo,Nr_z_Fo,Nr_r_Fo,Nr_y_M2,Nr_z_M2,Nr_r_M2,Nr_y_xM2, + + Nr_z_xM2,Nr_r_xM2 + + +c STATISTIK 'k' + parameter ( Nr_S1xM2 = 1 ) + parameter ( Nr_S1M2 = 2 ) + parameter ( Nr_S1Fo = 3 ) + parameter ( Nr_FoM2 = 4 ) + parameter ( Nr_S1M3 = 5 ) + parameter ( Nr_M3M2 = 6 ) + parameter ( Nr_t_FE = 7 ) + parameter ( Nr_y_Fo = 8 ) + parameter ( Nr_z_Fo = 9 ) + parameter ( Nr_r_Fo = 10 ) + parameter ( Nr_y_M2 = 11 ) + parameter ( Nr_z_M2 = 12 ) + parameter ( Nr_r_M2 = 13 ) + parameter ( Nr_y_xM2 = 14 ) + parameter ( Nr_z_xM2 = 15 ) + parameter ( Nr_r_xM2 = 16 ) + + integer Stat_Anzahl + parameter (Stat_Anzahl = 16) + + ! Kurznamen der Statistiken + integer LengthStatName + parameter (LengthStatName = 8) ! hier muss zwei mal die gleich + character statName(stat_Anzahl)*8 ! Zahl stehen + + integer What_Anzahl + parameter (What_Anzahl = 5) + + ! Kurznamen der statistischen Groessen: + integer LengthWhatName + parameter (LengthWhatName = 8) ! hier muss zwei mal die gleiche + character whatName(what_Anzahl)*8 ! Zahl stehen! + + +c=============================================================================== +c II. Variablen in Commonbloecken +c=============================================================================== + +c------------------------------------------------------------------------------- +c die Gebietsnummer +c------------------------------------------------------------------------------- + + integer Gebiet0 ! GebietsNummer beim Start + integer Gebiet ! aktuelle GebietsNummer + + integer StartFlaeche + + COMMON Gebiet0, StartFlaeche + + +c------------------------------------------------------------------------------- +c zufallsverteilte Startparameter +c------------------------------------------------------------------------------- + +c Energie: + + logical random_E0 ! Zufallsverteilung fuer Startenergie? + logical random_E0_equal ! gleichverteilte Startenergie + real lowerE0,upperE0 ! Grenzen fuer Zufallsverteilung + logical random_E0_gauss ! gaussverteilte Startenergie + real sigmaE0 ! Breite der Gaussverteilung + logical e0InterFromFile /.FALSE./ + real E0Low(101) + +c Position: + + logical random_pos ! Zufallsverteilung fuer Startposition? + logical random_y0z0_equal ! gleichverteilt auf Viereckflaeche + logical random_r0_equal ! gleichverteilt auf Kreisflaeche + logical random_y0z0_Gauss ! Gauss-verteilt auf Viereckflaeche + logical random_r0_Gauss ! Gauss-verteilt auf Kreisflaeche + real StartBreite,StartHoehe,StartRadius, sigmaPosition + +c Winkel: + + logical random_angle ! Zufallsverteilung fuer Startwinkel? + logical random_lambert ! Lambert-Verteilung + logical random_gauss ! Gauss-Verteilung + real StartLambertOrd + real SigmaWinkel ! Breite der Gaussverteilung + + logical ener_offset,pos_offset,angle_offset + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON random_E0,random_E0_equal,lowerE0,upperE0 + COMMON random_E0_gauss,sigmaE0 + COMMON e0InterFromFile,E0Low + COMMON random_pos,random_y0z0_equal, + + random_r0_equal,random_y0z0_Gauss,random_r0_Gauss, + + StartBreite,StartHoehe,StartRadius,sigmaPosition + COMMON random_angle,random_lambert,random_gauss + COMMON StartLambertOrd,sigmaWinkel + + COMMON ener_offset,pos_offset,angle_offset + + +c------------------------------------------------------------------------------- +c Schleifen-Parameter +c------------------------------------------------------------------------------- +c (par(n,0) wird fuer die 'Zufallsschleife' verwendet) + + real par(3,0:par_Anzahl) ! min, max und step der ParameterSchleifen + integer n_par(0:par_Anzahl) ! die Anzahl unterschiedl. Werte je Schleife + real parWert(par_Anzahl) ! der aktuelle Wert der Schleifenvariablen + character par_text(par_Anzahl)*22 ! Beschreibung jeder Variablen fuer Ausgabezwecke + + integer reihenFolge(par_Anzahl) ! Enthaelt die Reihenfolge der + ! Abarbeitung der Schleifenparameter + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON par, parWert, n_par, par_text, reihenfolge + + +c------------------------------------------------------------------------------- +c die Teilchenarten (artList) +c------------------------------------------------------------------------------- + + integer Arten_Zahl ! Anzahl der bekannten Arten + parameter (Arten_Zahl = 36) + + character*4 art_Name(Arten_Zahl) ! Bezeichnungen der bekannten Arten + real art_Masse(Arten_Zahl) ! Massen der bekannten Arten + real art_Ladung(Arten_Zahl) ! Ladungen der bekannten Arten + + character artList*50 ! TeilchenArten-Liste + character artList_prevSim*50 ! TeilchenArten-Liste bei ACCEL + ! und 'useFoilFile' + logical artList_defined ! wurde Teilchenart spezifiziert? + logical mu_flag ! signalisiert, ob Myon-Teilchen erkannt wurde + + integer artenMax ! Maximalzahl in artList + parameter (artenMax = 9) ! akzeptierter Arten + integer art_Nr(artenMax) ! die in artList enthaltenen Arten + integer artNr ! die Nummer der aktuellen Art + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON art_Name,art_Masse,art_Ladung + COMMON artList,artList_prevSim,artList_defined,mu_flag + COMMON art_Nr,artNr + + +c------------------------------------------------------------------------------- +c Trigger-Detektor +c------------------------------------------------------------------------------- + + logical TriggerInBeam ! TriggerDetektor im Strahlweg? + real Thickness ! Foliendicke + + logical log_aufstreu ! WinkelAufstreuung in Folie beruecksichtigen? + logical log_aufstreu_fixed ! Breite der Winkelverteilung fest vorgegeben + real sigmaAufstreu ! Sigma des Gaussverteilten Aufstreuwinkels + logical log_Meyer_Gauss ! Meyer-Formel mit Gaussfkt + logical log_Meyer_F_Function ! Meyer mit F-Funktion (genauer!) + + logical log_E_Verlust ! Energieverlust in TD-Folie beruecksichtigen? + logical log_E_Verlust_defined ! mittlerer Energieverlust vorgegeben? + logical log_E_Verlust_ICRU ! mittlerer E-Verlust gemaess ICRU? + logical log_E_Straggling_sigma ! Gausfoermige Energieverschmierung? + logical log_E_Straggling_equal ! Gleichmaessige Energieverschmierung? + logical log_E_Straggling_Lindhard ! Gaussfoermig nach Lindhard/Scharff + logical log_E_Straggling_Yang ! Gaussfoermig nach Yang + + logical calculate_each ! bei ICRU: fuer jedes Teilchen neu? + real mean_E_Verlust ! bei '_defined': mittlerer E-Verlust + + real sigmaE ! Breite der Verteilung der Verlustfunktion + real lowerE ! untere Grenze bei '_equal' + real upperE ! obere Grenze bei '_equal' + + logical graphitData + + logical log_neutralize + real neutral_fract(artenMax) ! Prozentzahl der zu neutralisiserenden Teilchen + + logical generate_FE ! FolienElektronen generieren? + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON /TRIGGERINBEAM/ TriggerInBeam + COMMON Thickness + COMMON log_aufstreu,log_aufstreu_fixed,sigmaAufstreu + COMMON log_Meyer_Gauss, log_Meyer_F_Function + COMMON log_E_Verlust,log_E_Verlust_defined,log_E_Verlust_ICRU, + + log_E_Straggling_sigma,log_E_Straggling_equal,log_E_Straggling_Lindhard, + + log_E_Straggling_Yang,mean_E_Verlust,calculate_each, + + sigmaE,lowerE,upperE + common /elossDataType/ graphitData + COMMON log_neutralize,neutral_fract + COMMON generate_FE + + +c------------------------------------------------------------------------------- +c Programmsteuerung +c------------------------------------------------------------------------------- + + logical alfaTgtVertically ! vertikale Variation des Targetwinkels + + real scaleFactor ! Skalierungsfaktor fuer die Kammergeometrie + + logical UseDecay ! MYONEN-Zerfall beruecksichtigen? + logical UseDecay_ ! MYONEN-Zerfall beruecksichtigen und Art ist myon? + logical UseDecay_prevSim! MYONEN-Zerfall bei ACCEL-Rechnung beruecksichtigt? + + logical DEBUG ! DEBUG-Version? + logical DEBUG_ ! DEBUG .AND. startNr.LE.DEBUG_Anzahl + logical DEBUG_FE ! FE in DEBUG-Info? + + logical log_alpha0_KS ! Startwinkel im Kammer-System gegeben? + logical notLastLoop + + logical BATCH_MODE ! -> keine Graphikausgabe; keine Ausgabe der + ! Prozentzahl schon gerechneter Trajektorien + logical INPUT_LIST ! spezielle Version eines Batch-Runs + integer ListLength ! + logical gotFileNr ! + character inputListName*20 + logical TestRun ! falls true, RunNummern zwischen 9900 und 9999 + logical log_confine ! Begrenze Schrittweite in Integrationsgebieten + ! -> 'dl_max_...' + logical TestOnWireHit ! Pruefen, ob Gitterstaebe getroffen werden + logical idealMirror ! Spiegel als ideal rechnen? + + logical upToTDFoilOnly ! Integration nur bis zum Erreichen der TD-Folie + logical createFoilFile ! File mit Trajektoriendaten bei Erreichen der + ! TD-Folie erstellen, das dann analog zu + ! den ACCEL-files eingelesen werden kann. + + logical lense2 ! Linse 2 zw. Spiegel und TD vorhanden ? + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON alfaTgtVertically + COMMON scaleFactor + COMMON UseDecay,UseDecay_,UseDecay_prevSim + COMMON DEBUG,DEBUG_,DEBUG_FE + COMMON log_alpha0_KS,notLastLoop + COMMON /BATCH_MODE/ BATCH_MODE + COMMON INPUT_LIST,ListLength,gotFileNr,inputListName + COMMON TestRun,log_confine,idealMirror + COMMON /TestOnWireHit/ TestOnWireHit + COMMON upToTDFoilOnly, createFoilFile + COMMON /lense2/ lense2 + + +c------------------------------------------------------------------------------- +c Graphikausgabe +c------------------------------------------------------------------------------- + + logical graphics ! graphisch Ausgabe? + integer graphics_Anzahl ! fuer wieviele Starts je Schleife? + logical graphics_ ! GRAPHICS .AND. startNr.LE.GRAPHICS_Anzahl + logical plot_FE ! Trajektorien der Folienelektronen plotten? + + integer n_postSkript ! PostSkript-files erstellen? + + integer iMonitor ! Abtastfrequenz fuer Graphik + integer color ! 0=schwarzweiss, 1=farbig + + integer schnitt_p ! Kammerteil fuer die Schnittebene der Graphik + real schnitt_x ! x-Koordinate der Schnittebenen + logical vertical ! Blick auf die Kammer von oben? + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON graphics,graphics_Anzahl,graphics_ + COMMON plot_FE, n_postSkript, iMonitor,schnitt_p + COMMON /PICT/ color, schnitt_x, vertical + + +c------------------------------------------------------------------------------- +c FileNamen +c------------------------------------------------------------------------------- + + character geo_fileName*60 ! Name des Files mit der Kammergeometrie + character filename*20 ! Name der Ausgabe-Dateien + character filename_ACCEL*40 ! gegebenenfalls Name des ACCEL-files + character filename_MUTRACK*40 ! gegebenenfalls Name des 'foilfiles' + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON geo_fileName + COMMON /filename/ filename + COMMON filename_ACCEL,filename_MUTRACK + + +c------------------------------------------------------------------------------- +c Vorgaben fuer das Summary (.LOG-file) +c------------------------------------------------------------------------------- + + integer n_outWhere ! LogFile auf welche Ausgabekanaele geben? + + logical LogFile ! Logfile erstellen? + logical smallLogFile ! minimalversion des Logfiles erstellen? + + logical statsInSummary ! Statistiken in das Summary? + logical statInSummary(Stat_Anzahl) ! welche Statistiken in das Summary? + + logical log_out_FE ! FolienElektronen-Statistik in das Summary? + logical log_out_pfosten(2)! getroffene TD-'Pfosten' in das Summary? + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON n_outWhere + COMMON LogFile,smallLogFile + COMMON statsInSummary,statInSummary + COMMON log_out_FE,log_out_pfosten + + +c------------------------------------------------------------------------------- +c WELCHE FILES sollen erzeugt werden? +c------------------------------------------------------------------------------- + + logical write_geo ! .GEO-file schreiben? + logical createPhysTab ! PAW-Gesamt-Tabelle (.PAW) erzeugen? + logical createNtp ! Ntuple (.NTP) erzeugen? + logical Fo_triggered ! nur Teilchen die die TD-Folie treffen in NTupel + logical xM2_triggered ! nur Teilchen die MCP2-Ebene erreichen ins NTupel + logical M2_triggered ! nur Teilchen die das MCP treffen ins NTupel + logical NTP_S1xM2 ! Flugzeit bis zur MCP2-EBENE ins NTupel? + logical NTP_times ! sonstige Flugzeiten ins NTupel? + logical NTP_FoM2Only ! nur TOF Folie-M2 ins NTupel? (ausser S1xM2) + logical NTP_charge ! Der Ladungszustand ins NTupel? + logical NTP_lifetime ! Die Lebensdauer ins NTupel? + logical NTP_start ! Die Startgroessen ...? + logical NTP_stop ! Die Stopgroessen ...? + logical NTP_40mm ! Die Groessen bei x=40mm ...? + logical NTP_Folie ! Everlust und Aufstreuungupel ...? + logical NTP_steps ! kleinste und groesste Schrittweiten ...? + logical NTP_Koord ! Die Trajektoriendaten ...? + + logical createTabellen ! Tabellen-files erzeugen? + logical createTabelle(Stat_Anzahl) ! welche Tabellen-files erzeugen? + + character TabExt(stat_Anzahl)*9 ! Extensions der Tabellenfiles + + logical smearS1Fo /.false./ + real sigmaS1Fo /1.6/ + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON write_geo,createPhysTab,createNtp + COMMON Fo_triggered,xM2_triggered,M2_triggered + COMMON NTP_S1xM2,NTP_times,NTP_FoM2Only,NTP_charge,NTP_lifetime,NTP_start,NTP_stop + COMMON NTP_40mm,NTP_Folie,NTP_steps,NTP_Koord + COMMON createTabellen,createTabelle,statName,whatName,TabExt + COMMON smearS1Fo,sigmaS1Fo + +c------------------------------------------------------------------------------- +c Fehlerkontrolle +c------------------------------------------------------------------------------- + + real eps_x ! Fehlertoleranz bei Ortsberechnung + real eps_v ! Fehlertoleranz bei Geschw.Berechnung + logical log_relativ ! relative Fehlerbetrachtung? + + integer maxStep ! maximale Anzahl an Integrationsschritten + + ! real deltaE in / 1 / (auch in initialize einbinden) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON eps_x,eps_v,log_relativ + COMMON maxStep + +c------------------------------------------------------------------------------- +c haeufig benutzte Faktoren +c------------------------------------------------------------------------------- + + real Energie_Faktor ! Faktor bei Berechn. der Energie aus der Geschw. + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON Energie_Faktor + + +c------------------------------------------------------------------------------- +c PHYSICA +c------------------------------------------------------------------------------- + + integer par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY + integer parList(par_Anzahl),statList(stat_Anzahl),whatList(what_Anzahl) + integer lengthParName + + logical statInPHYSICA(Stat_Anzahl) ! welche Statistiken in .PHYSICA file? + logical whatInPHYSICA(What_Anzahl) ! welche Statistiken in .PHYSICA file? + + integer LwPerRec ! Recordlaenge in MU_nnnn.PHYSICA in Longwords + parameter (LwPerRec = 50) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY + COMMON parList,statList,whatList + COMMON lengthParName + + COMMON statInPHYSICA,whatInPHYSICA + + +c------------------------------------------------------------------------------- +c Programmablauf +c------------------------------------------------------------------------------- + + real x0(3),v0(3),E0 ! Startort, -geschwindigkeit und -energie + real lifetime ! individuelle Myon-Lebensdauer [ns] + real theta0 ! 3D-Startwinkel gegen x_Achse + real phi0 ! azimuthaler Startwinkel (y-Achse:0, z-Achse:90) + + real x(3),t,v(3) ! Ort, Zeit, Geschwindigkeit +c real spin(3) ! Teichelspin (nicht benutzt) + integer destiny ! die Codezahl fuer das Schicksal des Projektils + + integer start_nr(2) ! Startnummer der Teilchen (1) und der FE (2) + integer GesamtZahl ! Gesamtzahl der Projektile + integer SchleifenZahl ! Anzahl durchzufuehrender Schleifen + integer SchleifenNr ! Nummer der aktuellen Schleife + integer Steps ! Nummer des Integrationssteps + + real dtsmall ! kleinster Zeitschritt fuer Integrationen + integer n_dtSmall ! wie oft hat Teilchen dtSmall unterschritten + integer n_dtsmall_Max ! wie oft wurde dtsmall max. unterschritten + integer dtsmall_counter ! wieviele Teilchen haben dtsmall unterschritten + integer maxBelowDtSmall + + integer LostInTD_counter! wieviele Teilchen wurden im TD abgeschrieben + integer Lost_counter ! wieviele Teilchen wurden sonst noch abgeschrieben + logical OneLoop ! genau eine Schleife + logical OneStartPerLoop ! Zufallsschleife macht genau einen Durchlauf + + logical log_percent + + logical Use_ACCEL ! ACCEL-Daten verwenden + logical Use_MUTRACK ! 'FoilFile'-Daten verwenden + logical fromScratch ! .NOT.(Use_ACCEL.OR.Use_MUTRACK) + + logical previousSettings ! Parametervorgaben von ACCEL uebernehmen? + integer firstIndx(10),IndxIncr(10),parIndx(10) + integer eventNr ! korrespondierende Eventnummer im ACCEL-NTP + + logical guard ! Potential am Guardring frei variierbar? + + integer randomStarts_prevSim ! 'randomStarts' bei ACCEL und 'foilFile' + integer seed ! fuer Zufallsgenerator + + logical reachedEndOfMap ! bei FolienMappe oder MCP2Mappe x=xmax erreicht + + logical gridInFrontOfFoil + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Die benannten Common-Bloecke werden fuer die NTP-Ausgabe benoetigt! + +c die separaten Commonblocks sind fuer die Routine HBNAME der CERN library +c wichtig wenn es darum geht, frueher erzeugte NTP einzulesen. Ansonsten kommt +c (zumindest auf der PSW264, auf der PSICLC u.U. nicht (-> Option 'align=all' +c beim FORTRAN Befehl auf der alpha)) z.B. die Fehlermeldung +c +c Variable LIFETIME +c ***** ERROR in HBNAME : Address not word aligned : +c Variable GEBIET +c ***** ERROR in HBNAME : Address not word aligned : +c Variable T +c ***** ERROR in HBNAME : Address not word aligned : + + COMMON /gebiet/ gebiet,destiny ! Reihenfolge wichtig fuer NTupel! + COMMON /lifetime/ lifetime + COMMON /x0/ x0 + COMMON /v0/ v0 + COMMON /E0/ E0 + COMMON /theta0/ theta0,phi0 + COMMON /t/ t,x,v ! Reihenfolge wichtig fuer NTupel! + COMMON /ntp_steps/ steps ! in MUTRACK wird noch weiteres angefuegt! + + COMMON /loop/ SchleifenNr + COMMON start_Nr + COMMON GesamtZahl,SchleifenZahl + COMMON dtsmall, n_dtsmall, n_dtsmall_Max, dtsmall_counter + COMMON maxBelowDtSmall + COMMON LostInTD_counter,Lost_counter + COMMON OneLoop, OneStartPerLoop + + COMMON log_percent + COMMON Use_ACCEL,Use_MUTRACK,fromScratch + COMMON previousSettings,firstIndx,IndxIncr,parIndx,eventNr + COMMON guard + COMMON randomStarts_prevSim + COMMON /seed/ seed ! das Common /seed/ ist auch in den Routinen + ! 'GAUSS_VERTEILUNG' und 'GAUSS_VERTEILUG_THETA' + ! in MUTRACK.FOR definiert + + COMMON reachedEndOfMap + COMMON /foilGrid/ gridInFrontOfFoil + + +c------------------------------------------------------------------------------- +c Statistik +c------------------------------------------------------------------------------- + + integer statTD(2,18) ! Statistik der Returncodes des TDs + integer pfostenHit(75,2) ! Statistik der Pfostentreffen im TD (75 oder 45?) + integer statDestiny(smallest_code_Nr:Gebiete_Anzahl*highest_code_Nr) + ! Statistik der Teilchenschicksale + + real statMem(9,stat_Anzahl) ! Statistik der Ergebnisse der Bahnberechnung + logical statNeeded(stat_Anzahl) ! welche Statistiken muessen fuer die + ! geforderten Informationen gefuehrt werden? + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + COMMON statTD,pfostenHit,statDestiny + COMMON statMem,statNeeded + + +c------------------------------------------------------------------------------- +c Ein- und Ausgabekanaele +c------------------------------------------------------------------------------- + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + + integer*4 NTP_write, NTP_read + parameter (NTP_write=5, NTP_read = NTP_write+1) + + +c------------------------------------------------------------------------------- +c Datenausgabe +c------------------------------------------------------------------------------- + + INCLUDE 'mutrack$sourcedirectory:COM_OUTPUT.INC' + diff --git a/mutrack/src/COM_OUTPUT.INC b/mutrack/src/COM_OUTPUT.INC new file mode 100644 index 0000000..df556ec --- /dev/null +++ b/mutrack/src/COM_OUTPUT.INC @@ -0,0 +1,23 @@ + +c=============================================================================== +c COM_OUTPUT.INC +c=============================================================================== + +c Die Deklaration der Variablen und des Commonblocks fuer die DatenAusgabe +c im Programm 'MUTRACK' wird sowohl von den Ausgaberoutinen des Hauptprogramms +c als auch von den zum TriggerDetektor gehoerenden Routinen benoetigt und sind +c daher in diesem separaten include-file niedergelegt. + + integer DEBUG_StartNr + integer DEBUG_Anzahl ! fuer wieviele Starts je Schleife sollen + ! (so ueberhaupt) DEBUG-Informationen ausgegeben + ! werden? + + integer lun(2), indx + integer indx1, indx2 + + COMMON /OUTPUT/ lun, indx1,indx2, indx, DEBUG_StartNr, DEBUG_Anzahl + +c 'indx' steht nur im COMMON-Block, damit die Meldungen 'declared but not used' +c unterbleiben! + diff --git a/mutrack/src/COM_TD_EXT.INC b/mutrack/src/COM_TD_EXT.INC new file mode 100644 index 0000000..9062b19 --- /dev/null +++ b/mutrack/src/COM_TD_EXT.INC @@ -0,0 +1,20 @@ + +c=============================================================================== +c COM_TD_EXT.INC +c=============================================================================== + +c Dieser include-file declariert diejenigen Variablen, die den Routinen in +c der Fortran-Text-Datei SUB-TD-CALC und der Routine, welche das Sub. TD_CALC +c aufruft, gemeinsam sind und definiert den zugehoerigen COMMON-Block: + +c - die am Trigger-Detektor anliegenden Spannungen: + + real U_F ! die Spannung an der FOLIE (F) + real U_V ! die Spannung am vorderen Gitter (V) + real U_H ! die Spannung am hinteren Gitter (H) + real U_MCP3 ! die Spannung an der Vorderseite von MCP-3 (3) + +c - der COMMOM-Block: + + COMMON /TRIGGERSETTINGS/ U_F,U_V,U_H,U_MCP3 + diff --git a/mutrack/src/COM_TD_INT.INC b/mutrack/src/COM_TD_INT.INC new file mode 100644 index 0000000..8f66ae0 --- /dev/null +++ b/mutrack/src/COM_TD_INT.INC @@ -0,0 +1,25 @@ + +c=============================================================================== +c COM_TD_INT.INC +c=============================================================================== + +c Dieser include-file declariert diejenigen Variablen, die den Routinen in +c der Fortran-Text-Datei SUB-TD-CALC gemeinsam zugaenglich sind, und definiert +c den zugehoerigen COMMON-Block: + +c - die Teilchen-Parameter Ladung, Masse, Ort, Geschw., Startenergie + real q, m, t, x, y, z, v_x, v_y, v_z, E0 + +c - was ausgegeben werden soll: + logical DEBUG, GRAPHICS + +c - die Return-Variable: + integer n_return + +c - logicals, die anzeigen, ob das Teilchen schon einmal reflektiert wurde: + logical log_refl_Vh, log_refl_V3 + +c - der COMMON-Block: + COMMON /INTERN/ q, m, t, x, y, z, v_x, v_y, v_z, E0 + COMMON /INTERN/ DEBUG,GRAPHICS, n_return,log_refl_VH,log_refl_V3 + diff --git a/mutrack/src/COM_WINKEL.INC b/mutrack/src/COM_WINKEL.INC new file mode 100644 index 0000000..a03c347 --- /dev/null +++ b/mutrack/src/COM_WINKEL.INC @@ -0,0 +1,24 @@ + +c=============================================================================== +c COM_WINKEL.INC +c=============================================================================== + +c Da die Drehwinkel von Moderator (= Target), Spiegel und Triggerdetektor +c in mehreren Routinen des Programms 'MUTRACK' sowohl innerhalb als auch +c ausserhalb der Trigger-Komplexes benoetigt wird, steht dieser Commonblock in +c diesem separaten Include-file. (Auch in SUB_PICTURE verwendet) + + real alfaTgt ! Tgt <-> Target + real Sin_alfaTgt, Cos_alfaTgt ! Target-Verdrehung + + real alfaSp ! Sp <-> Spiegel + real Sin_alfaSp , Cos_alfaSp , Tan_AlfaSp ! Spiegel-Verdrehung + + real alfaTD ! TD <-> TriggerDetektor + real Sin_alfaTD , Cos_alfaTD , Tan_alfaTD ! Trigger-Verdrehung + + + COMMON /ANGLES/ alfaTgt, Sin_alfaTgt, Cos_alfaTgt + COMMON /ANGLES/ alfaSp, Sin_alfaSp, Cos_alfaSp, Tan_AlfaSp + COMMON /ANGLES/ alfaTD, Sin_alfaTD, Cos_alfaTD, Tan_alfaTD + diff --git a/mutrack/src/GEO_TRIGGER.INC b/mutrack/src/GEO_TRIGGER.INC new file mode 100644 index 0000000..069073b --- /dev/null +++ b/mutrack/src/GEO_TRIGGER.INC @@ -0,0 +1,123 @@ + +c=============================================================================== +c GEO_TRIGGER.INC +c=============================================================================== + +c******************************************************************************* +c* * +c* Diese Datei enthaelt die geometrischen Daten des NEMU-Triggerdetektors * +c* in seiner ersten Version. * +c* * +c* Die Definitionen der Groessen sind im Ordner 'MUTRACK' niedergelegt! * +c* Alle Angaben sind in [mm]. * +c* * +c* Stand: Run VI. Die Werte wurden einer Konstruktionszeichnung entnommen * +c* * +c* >> 2.12.1994 >> ahofer@psiclu.cern.ch * +c* * +c******************************************************************************* + + +c Laengen in x-Richtung: + + real dx1,dx2,dx3,dx4,dx5,dx6,dx7,dx8,dx9,dx10,dx11 + + parameter (dx1 = 8, dx2 =37, dx3 =14, dx4 =42, !dx5 = 8, + + dx6 =12, dx7 =12, dx8 =19, dx9 =23, dx10=10, dx11=14) + + DATA dx5 / 8 / + COMMON /dx5/ dx5 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Laengen in y-Richtung: + + real dy1,dy2,dy3,dy4,dy5,dy6,dy7,dy8,dy9,dy10,dy11 + real dy12,dy13,dy14,dy15 + + parameter (dy1 =20, dy2 =20, dy3 =25, dy4 =25, dy5 =25, + + dy6 =32, dy7 =30, dy8 =42, dy9 =40, dy10=11, + + dy11=32, dy12=30, dy13=30, dy14=30, dy15=30) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Laengen in z-Richtung: + + real dz1, dz2 + + parameter (dz1 =30, dz2 =30) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + real d_Grid_Folie ! Abstand zwischen + parameter (d_Grid_Folie = 18) ! Gitter und Folie + +c Abgeleitete Laengen: + + real d_Folie_Achse ! Abstand zwischen Folie + parameter (d_Folie_Achse = dx1+dx2+dx3/2) ! und Trigger-Achse + + real d_Folie_Hinten2 ! Abstand zwischen Folie + parameter (d_Folie_Hinten2 = dx1+dx2+dx3+dx4) ! und 2. Gitter von H + + real radiusQuad_Folie ! in MUTRACK.INPUT? + parameter (radiusQuad_Folie = 20*20 ) + + real radiusQuad_Folie_max ! <------ nicht benutzt! + parameter (radiusQuad_Folie_max = 26*26) ! maximaler Folienradius + + real xCenter_MCP3, radius_MCP3, radiusQuad_MCP3 + parameter (radius_MCP3 = ((dx2+dy8-dx11)-(dx9))/2. ) + parameter (radiusQuad_MCP3 = radius_MCP3 * radius_MCP3) + parameter (xCenter_MCP3 = dx1+dx9+radius_MCP3) ! x-Pos. der Mitte von + ! MCP3 im Triggersystem +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Gitterdrahtabstaende und -durchmesser: +c (Nachdem diese Groessen in Run 10 geaendert wurden muessen sie nun als +c Variable gehandhabt werden) + + real dist_Wires_V1 /1.5/, dWires_V1 /.050/ + real dist_Wires_V2 /1.5/, dWires_V2 /.050/ + real dist_Wires_V3 /1.5/, dWires_V3 /.050/ + real dist_Wires_H1 /1.5/, dWires_H1 /.050/ + real dist_Wires_H2 /1.5/, dWires_H2 /.050/ + real dist_Wires_G /1.5/, dWires_G /.050/ + + real WireRadiusQuad_V1, WireRadiusQuad_V2, WireRadiusQuad_V3 + real WireRadiusQuad_H1, WireRadiusQuad_H2, WireRadiusQuad_G + + COMMON /TD_GEO/ + + dist_Wires_V1,dist_Wires_V2,dist_Wires_V3, + + dist_Wires_H1,dist_Wires_H2,dist_Wires_G, + + dWires_V1,dWires_V2,dWires_V3,dWires_H1,dWires_H2,dWires_G, + + WireRadiusQuad_V1,WireRadiusQuad_V2,WireRadiusQuad_V3, + + WireRadiusQuad_H1,WireRadiusQuad_H2,WireRadiusQuad_G + +c parameter (dist_Wires_V1 = 1.5 , dWires_V1 = .050) +c parameter (dist_Wires_V2 = 1.5 , dWires_V2 = .050) +c parameter (dist_Wires_V3 = 1.5 , dWires_V3 = .050) +c parameter (dist_Wires_H1 = 1.5 , dWires_H1 = .050) +c parameter (dist_Wires_H2 = 1.5 , dWires_H2 = .050) +c parameter (dist_Wires_G = 1.5 , dWires_G = .050) + + +c die Berechnung der Quadrate wird jetzt in SUBROUTINE READ_TRIGGER_GEO erledigt +c +c parameter (WireRadiusQuad_V1 = dwires_V1*dWires_V1/4., +c + WireRadiusQuad_V2 = dwires_V2*dWires_V2/4., +c + WireRadiusQuad_V3 = dwires_V3*dWires_V3/4., +c + WireRadiusQuad_H1 = dwires_H1*dWires_H1/4., +c + WireRadiusQuad_H2 = dwires_H2*dWires_H2/4., +c + WireRadiusQuad_G = dwires_G *dWires_G /4.) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Effizienz von MCP3: + + real efficiencyM3 + parameter (efficiencyM3 = .75) +c parameter (efficiencyM3 = .50) + diff --git a/mutrack/src/INITIALIZE.INC b/mutrack/src/INITIALIZE.INC new file mode 100644 index 0000000..7a59689 --- /dev/null +++ b/mutrack/src/INITIALIZE.INC @@ -0,0 +1,464 @@ +c Diese Datei enthaelt Initialisierungen fuer das Programm TOF zur Berechnung +c von Flugzeiten zwischen MCP3 und MCP2 der NEMU-Apparatur. +c Die Deklaration der Variablen findet im Include-file 'COM_MUTRACK.INC' +c statt. + +c die Spezifizierungen der Schleifen-Parameter (character*22): + + par_text(UTgt ) = 'U(TARGET) [kV] : ' + par_text(UGua ) = 'U(GUARD) [kV] : ' + par_text(UG1 ) = 'U(GITTER) [kV] : ' + par_text(UL1 ) = 'U(L1) [kV] : ' + par_text(USp ) = 'U(SPIEGEL)[kV] : ' + par_text(UL2 ) = 'U(L2) [kV] : ' + par_text(UL3 ) = 'U(L3) [kV] : ' + par_text(UFolie ) = 'U(FOLIE) [kV] : ' + par_text(UVorne ) = 'U(VORNE) [kV] : ' + par_text(UHinten) = 'U(HINTEN) [kV] : ' + par_text(UMCP3 ) = 'U(MCP3) [kV] : ' + + par_text(UMCP2 ) = 'U(MCP2) [kV] : ' + + par_text(BTD ) = 'B(TD) [Gauss] : ' + par_text(BHelm ) = 'B(Helmh.) [Gauss] : ' + + par_text(alfTgt ) = 'alpha_Tgt [degree] : ' + par_text(alfSp ) = 'alpha_Sp [degree] : ' + par_text(alfTD ) = 'alpha_TD [degree] : ' + + par_text(mass ) = 'Masse [keV/c**2]: ' + par_text(charge ) = 'Ladung [e] : ' + par_text(ener ) = 'Energie [keV] : ' + par_text(yPos ) = 'y0 [mm] : ' + par_text(zPos ) = 'z0 [mm] : ' + par_text(thetAng) = 'theta0 [degree] : ' + par_text(phiAng ) = 'phi0 [degree] : ' + + par_text(Thickn ) = 'Thickness [ug/cm^2] : ' + par_text(Eloss ) = 'E-Verlust [keV] : ' + + par_text(deltaL1) = 'delta_L1 [mm] : ' + par_text(deltaL2) = 'delta_L2 [mm] : ' + + +c Groesste Laenge einer Parameterbezeichnung (ohne Einheitenangabe) in +c 'par_text': + + lengthParName = 10 + + +c die Gebiets-Bezeichnungen (character*40): + + Gebiet_Text(upToGrid1) = 'in 1. Beschl.Stufe:' + Gebiet_Text(upToGrid2) = 'in 2. Beschl.Stufe:' + Gebiet_Text(upToHeShield) = 'bis He-Schild:' + Gebiet_Text(upToLNShield) = 'bis LN-Schild:' + Gebiet_Text(upToL1Map) = 'vor Linse-1-Mappe:' + Gebiet_Text(upToExL1) = 'in Linse-1-Mappe:' + Gebiet_Text(upToEnSp) = 'bis Spiegel:' + Gebiet_Text(upToExSp) = 'im Spiegel:' + Gebiet_Text(upToChKoord) = 'bis Koordinatenwechsel:' + Gebiet_Text(upToEnTD) = 'bis TriggerDetektor:' + Gebiet_Text(upToExTD) = 'im TriggerDetektor:' + Gebiet_Text(upToL2andFoMap) = 'vor Linse-2-Mappe:' + Gebiet_Text(upToExL2) = 'in Linse-2-Mappe:' + Gebiet_Text(upToL3Map) = 'vor Linse-3-Mappe:' + Gebiet_Text(upToExL3) = 'in Linse-3-Mappe:' + Gebiet_Text(upToM2Map) = 'zwischen Linse-3-Mappe und MCP2-Mappe:' + Gebiet_Text(upToMCP2) = 'vor MCP2:' + + +c die Bezeichnungen fuer die moeglichen Teilchenschicksale (character*26): + + code_text(code_ok ) = 'MCP2 getroffen: ' + code_text(code_durchSpiegel ) = 'Spiegel durchquert: ' + code_text(code_Stuetzgitter ) = 'Folienstuetzgitter getr.: ' + code_text(code_lostInTD ) = 'im TD abgebrochen: ' + code_text(code_NotRegInM3 ) = 'von MCP3 nicht registriert: ' + code_text(code_hitBlende ) = 'auf Blende des MCP2: ' + code_text(code_hitMCP2inactive) = 'auf Rand des MCP2: ' + + code_text(code_frontOfMapAc ) = 'ACCEL: vor Mappe (FEHLER!): ' + code_text(code_leftMapAc ) = 'ACCEL: seitlich aus Mappe: ' + code_text(code_hit_TgtHolder ) = 'Targethalter getroffen: ' + + code_text(code_stopped_in_foil) = 'in Triggerfolie gestoppt: ' + + code_text(code_decay ) = 'zerfallen: ' + code_text(code_vorbei ) = 'Element verfehlt: ' + code_text(code_reflektiert ) = 'reflektiert: ' + code_text(code_grid ) = 'auf Gitter getroffen: ' + code_text(code_wand ) = 'aufgeschlagen: ' + code_text(code_lost ) = 'verloren (steps>maxsteps): ' + code_text(code_dtsmall ) = 'Zeitschritt kleiner dtSmall:' + + +c die Bezeichnungen der Statistiken (character*8): + + statName(Nr_S1xM2) = 'S1xM2 ' + statName(Nr_S1M2) = 'S1M2 ' + statName(Nr_S1Fo) = 'S1Fo ' + statName(Nr_FoM2) = 'FoM2 ' + statName(Nr_S1M3) = 'S1M3 ' + statName(Nr_M3M2) = 'M3M2 ' + statName(Nr_t_FE) = 't(FE) ' + statName(Nr_y_Fo) = 'y(FOLIE)' + statName(Nr_z_Fo) = 'z(FOLIE)' + statName(Nr_r_Fo) = 'r(FOLIE)' +c statName(Nr_y_xFo) = 'y(xFOLIE)' +c statName(Nr_z_xFo) = 'z(xFOLIE)' +c statName(Nr_r_xFo) = 'r(xFOLIE)' + statName(Nr_y_M2) = 'y(MCP2) ' + statName(Nr_z_M2) = 'z(MCP2) ' + statName(Nr_r_M2) = 'r(MCP2) ' + statName(Nr_y_xM2) = 'y(xMCP2)' + statName(Nr_z_xM2) = 'z(xMCP2)' + statName(Nr_r_xM2) = 'r(xMCP2)' + + +c die Bezeichnungen der statistischen Groessen (character*8): + + whatName(1) = 'mean ' + whatName(2) = 'variance' + whatName(3) = 'minimum ' + whatName(4) = 'maximum ' + whatName(5) = 'percent ' + + +c die Extensions der Tabellen-files (character*9): + + TabExt(Nr_S1xM2) = '._S1xM2 ' + TabExt(Nr_S1M2) = '._S1M2 ' + TabExt(Nr_S1Fo) = '._S1Fo ' + TabExt(Nr_FoM2) = '._FoM2 ' + TabExt(Nr_S1M3) = '._S1M3 ' + TabExt(Nr_M3M2) = '._M3M2 ' + TabExt(Nr_t_FE) = '._T_FE ' + TabExt(Nr_y_Fo) = '._Y_FO ' + TabExt(Nr_z_Fo) = '._Z_FO ' + TabExt(Nr_r_Fo) = '._R_FO ' + TabExt(Nr_y_M2) = '._Y_M2 ' + TabExt(Nr_z_M2) = '._Z_M2 ' + TabExt(Nr_r_M2) = '._R_M2 ' + TabExt(Nr_y_xM2) = '._Y_xM2 ' + TabExt(Nr_z_xM2) = '._Z_xM2 ' + TabExt(Nr_r_xM2) = '._R_xM2 ' + + +c die Reihenfolge, in welcher die Schleifen der 'Schleifenparameter' par(i,k) +c im Hauptprogramm abgearbeitet werden: +c Aenderungen in der Reihenfolge brauchen in den Routinen fuer die graphische +c Darstellung mittels 'PHYSICA' nicht durch entsprechende Aenderungen in den +c jeweiligen files beruecksichtigt werden (PHYSICA bekommt die Reihenfolge ueber +c die .PHYSICA - files selbst mitgeteilt). +c Diese files sind nur anzugleichen, falls die Zuordnungen der verschiedenen +c physikalischen Groessen zu ihren jeweiligen Code-Nummern geaendert werden, +c bzw. wenn zusaetzliche Schleifengroessen aufgenommen werden +c (-> mutrack$PHYSICAdirectory: 'xxx.FOR'- und 'xxx.PCM'-Dateien). +c Desweiteren koennen ACCEL und 'foilFile' durchaus andere Reihenfolgen ver- +c wendet haben. + + DATA reihenfolge / + + DeltaL1,DeltaL2,Eloss,Thickn, + + UMCP2, alfTgt,alfSp,alfTD, + + UVorne,UHinten,UMCP3, + + UFolie,UL2, USp,UL1,UL3, + + BHelm,BTD, + + mass,charge, UTgt,UGua,UG1, + + ener,thetAng,phiAng,yPos,zPos / + + +c====== Initialisierungen fuer die benutzerdefinierbaren Parameter ============ + +c Das Startgebiet 'Gebiet0' wird indirekt im SUB 'READ_INPUTFILE' via die +c lokalen Variablen 'Startflaeche', bzw. 'x0_' und 'Kammerteil' initialisiert. + +c - - - - - - - - - - zufallsverteilte Startparameter - - - - - - - - - - - - - + +c Energie: + + DATA random_E0 /.false./ + + DATA random_E0_equal /.false./ + DATA lowerE0 / 0.000 / + DATA upperE0 / 0.010 / + + DATA random_E0_gauss /.false./ + DATA sigmaE0 / 0.010 / + + +c Position: + + DATA random_pos /.false./ + DATA sigmaPosition / 15. / + + DATA random_y0z0_equal /.false./ + DATA random_r0_equal /.false./ + DATA random_y0z0_Gauss /.false./ + DATA random_r0_Gauss /.false./ + DATA StartBreite / -1. / + DATA StartHoehe / -1. / + DATA StartRadius / -1. / + + +c Winkel: + + DATA random_angle /.false./ + + DATA random_lambert /.false./ + DATA random_gauss /.false./ + DATA StartLambertOrd / 1. / + DATA sigmaWinkel / 1. / + + DATA ener_offset / .true. / + DATA pos_offset / .true. / + DATA angle_offset / .true. / + +c - - - - - - - - - - Schleifen-Parameter - - - - - - - - - - - - - - - - - - - + + ! Das Schleifenparameterfeld 'par(i,k)' (1 <= k <= par_Anzahl) + ! wird indirekt im SUB 'read_inputFile' ueber die dortigen lokalen + ! Variablen initialisiert (siehe dort). + ! Hier wird nur die 'Zufallsschleife' par(i,0) initialisiert. + + DATA par(1,0) / 1. / + DATA par(2,0) / 1. / + DATA par(3,0) / 1. / + + +c - - - - - - - - - - Projektile- - - - - - - - - - - - - - - - - - - - - - - - + + DATA art_Name / 'm+ ', 'm- ', ! character*4 + + 'Mu ', 'Mu- ', + + 'e+ ', 'e- ', + + 'H+ ', 'H ', 'H- ', + + 'H2+ ', 'H2 ', 'H2- ', + + 'alfa', + + + 'A11+', 'A12+', 'A21+', 'A31+', 'A32+', + + 'N11+', 'N21+', + + 'K11+', 'K12+', + + + 'H2O1', 'H2O2', 'H2O3', 'H2O4', 'H2O5', + + + 'Hyd1', 'Hyd2', 'Hyd3', 'Hyd4', 'Hyd5', + + 'Hyd6', 'Hyd7', 'Hyd8', 'Hyd9' + + / + +c folgende Werte wurden aus bzw. mittels 'HANDBOOK OF CHEMESTRY AND PHYSICS, +c 74th edition' und 'PHYSICAL REVIEW D, 50, S.1173-1826 (August 1994)' bestimmt: + + DATA art_Masse / 105658., 105658., + + 106169., 106680., + + 510.9991, 510.9991, + + 938272.3, 938783.3, 939294.3, + + 1877055.6, 1877566.6, 1878077.6, + + 3727380.2, + + + 37.96238E6,37.22371E6,74.44896E6,111.673689E6,111.673178E6, + + 13.043273 ,26.087057, + + 78.16258E6,78.162070E6, + + + 16.77623E6,33.55297E6,50.32971E6,67.10644E6,83.88318E6, + + + 17.71501E6,34.49175E6,51.26849E6,68.04523E6,84.82197E6, + + 101.59870E6,118.37544E6,135.15218E6,151.92892E6 + + + / + + DATA art_Ladung / +1., -1., + + 0., -1., + + +1., -1., + + +1., 0., -1., + + +1., 0., -1., + + +2., + + + +1., +2., +1., +1., +2., + + +1., +1., + + +1., +2., + + + +1., +1., +1., +1., +1., + + + +1., +1., +1., +1., +1., + + +1., +1., +1., +1. + + / + + DATA neutral_fract / artenMax*0. / + + DATA artList / ' ' / + DATA artList_defined /.false./ + +c - - - - - - - - - - Trigger-Detektor- - - - - - - - - - - - - - - - - - - - - + + DATA TriggerInBeam / .false. / + DATA Thickness / 3.0 / + + DATA log_aufStreu / .false. / + DATA log_aufstreu_fixed / .false. / + DATA log_Meyer_Gauss / .false. / + DATA log_Meyer_F_Function / .false. / + DATA sigmaAufstreu / 5. / + + DATA log_E_Verlust / .false. / + DATA log_E_Verlust_defined / .false. / + DATA log_E_Verlust_ICRU / .false. / + + DATA log_E_Straggling_sigma / .false. / + DATA log_E_Straggling_equal / .false. / + DATA log_E_Straggling_Lindhard / .false. / + DATA log_E_Straggling_Yang / .false. / + + DATA mean_E_Verlust / 2.5 / + DATA calculate_each / .false. / + + DATA sigmaE / 0.5 / + DATA lowerE / 0. / + DATA upperE / 0.1 / + + DATA graphitData / .false. / + + DATA log_neutralize / .false. / + + DATA generate_FE / .false. / + DATA TransTDFoil / 100. / + + +c - - - - - - - - - - Programmsteuerung - - - - - - - - - - - - - - - - - - - - + + DATA alfaTgtVertically/ .false. / + + DATA scaleFactor / 1. / + + DATA UseDecay / .false. / + DATA UseDecay_ / .false. / + DATA UseDecay_prevSim / .false. / + + DATA DEBUG / .false. / + DATA DEBUG_FE / .false. / + + DATA log_alpha0_KS / .false. / + + DATA gotFileNr / .false. / + DATA TestRun / .false. / + DATA log_confine / .false. / + + DATA TestOnWireHit / .false. / + + DATA upToTDFoilOnly / .false. / + DATA createFoilFile / .false. / + + DATA lense2 / .false. / + +c - - - - - - - - - - Graphikausgabe- - - - - - - - - - - - - - - - - - - - - - + + DATA GRAPHICS / .false. / + DATA GRAPHICS_Anzahl / 25 / + DATA plot_FE / .false. / + DATA vertical / .true. / + + DATA n_postSkript / 1 / + + DATA imonitor / 2 / + DATA color / 0 / + DATA schnitt_p / 2 / + DATA schnitt_x / -1. / + +c - - - - - - - - - - FileName- - - - - - - - - - - - - - - - - - - - - - - - - + + DATA filename / 'MU_' / + +c - - - - - - - - - - Vorgaben fuer das Summary - - - - - - - - - - - - - - - - + + DATA n_outWhere / 2 / + + DATA LogFile / .false. / + DATA smallLogFile / .false. / + + DATA statsInSummary / .false. / + + ! 'statInSummary' wird indirekt im SUB 'read_inputFile' ueber die + ! lokalen Variablen 'SUM_*' initialisiert (alle auf .false.) + + DATA log_out_FE / .false. / + DATA log_out_pfosten / .false. , .false./ + +c - - - - - - - - WELCHE FILES sollen erzeugt werden? (ausser .SUM)- - - - - - + + DATA createTabellen / .false. / + + ! 'createTabelle' wird indirekt im SUB 'read_inputFile' ueber die + ! lokalen Variablen 'TAB_*' initialisiert (alle auf .false.) + + DATA createPhysTab / .false. / + + DATA createNtp / .false. / + DATA Fo_triggered / .false. / + DATA xM2_triggered / .false. / + DATA M2_triggered / .false. / + DATA NTP_Koord / .false. / + DATA NTP_S1xM2 / .false. / + DATA NTP_times / .false. / + DATA NTP_FoM2Only / .false. / + DATA NTP_charge / .false. / + DATA NTP_start / .false. / + DATA NTP_stop / .false. / + DATA NTP_40mm / .false. / + DATA NTP_Folie / .false. / + DATA NTP_steps / .false. / + DATA NTP_Koord / .false. / + +c - - - - - - - - - - Fehlerkontrolle - - - - - - - - - - - - - - - - - - - - - + + DATA eps_x / 1.e-5 / + DATA eps_v / 1.e-5 / + DATA log_relativ / .false. / + + DATA maxStep / 6000 / + + DATA dtsmall / .001 / + DATA maxBelowDtSmall / 50 / + + DATA idealMirror / .false. / + +c - - - - - - - - - - Programmablauf- - - - - - - - - - - - - - - - - - - - - - + + DATA accelVersionIndx / -1 / + DATA mutrackVersionIndx / -1 / + + DATA n_dtsmall / 0 / + DATA n_dtsmall_Max / 0 / + DATA dtsmall_counter / 0 / + DATA LostInTD_counter / 0 / + DATA Lost_counter / 0 / + + DATA Startflaeche / 0 / + DATA SchleifenNr / 0 / + +c Ausgabekanaele (fuer die 'do indx = indx1, indx2 ....' Anweisungen): + + DATA lun / lunLOG, lunScreen / + + DATA OneLoop / .false. / + DATA OneStartPerLoop / .false. / + + DATA log_percent / .false. / + + DATA Use_ACCEL / .false. / + DATA Use_MUTRACK / .false. / + DATA fromScratch / .true. / + + DATA previousSettings / .false. / + + DATA guard / .true. / + + DATA gridInFrontOfFoil / .false. / + +c fuer Random-Generator: 'seed' soll gross und ungerade sein. -> +c nimm den Sinus von secnds, und mache daraus durch Multiplikation mit ent- +c sprechender 10er-Potenz eine 8stellige Integer-Zahl. Sollte seed dann +c gerade sein, mache es ungerade: + + help1= abs(sin(secnds(0.))) ! abs(), da sonst log10(sec) zu Fehler fuehrt + seed = int(help1* 10.**(8-int(log10(help1)) ) ) + if ((seed/2)*2.EQ.seed) seed=seed-1 ! z.B. seed=3 -> seed/2=1, wegen Integer + diff --git a/mutrack/src/MAP_DEF_FO.INC b/mutrack/src/MAP_DEF_FO.INC new file mode 100644 index 0000000..eecd8f1 --- /dev/null +++ b/mutrack/src/MAP_DEF_FO.INC @@ -0,0 +1,50 @@ + +c=============================================================================== +c MAP_DEF_FO.INC +c=============================================================================== + +c in diesem File sind die notwendigen Groessen und Speicher fuer die Integration +c der Teilchenbahnen im Bereich vor der TD-Folie mittels des Programms 'MUTRACK' +c niedergelegt: + +c general items: +c (also known in some other parts of the program via include file +c 'COM_KAMMER.INC') + + real Beschl_Faktor + COMMON /Beschl_Faktor_Fo/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + real MappenLaenge + real xEnterMap + + COMMON /integration_Fo/ MappenName,dl_max,MappenLaenge,xEnterMap + + +c the grid characteristics: + + real Dx,Dr + integer imax,jmax + real xmax,rmax + + COMMON /integration_Fo/ Dx,Dr,imax,jmax,xmax,rmax + + +c der Uebergabebereich am MappenEnde: + + real xStartUeber + real xEndUeber + + COMMON /integration_FO/ xStartUeber,xEndUeber + + +c the map: + + integer maxmem + parameter (maxmem = 20595) + real map(0:maxmem) + + COMMON /integration_Fo/ map + diff --git a/mutrack/src/MAP_DEF_L1.INC b/mutrack/src/MAP_DEF_L1.INC new file mode 100644 index 0000000..01dbbb8 --- /dev/null +++ b/mutrack/src/MAP_DEF_L1.INC @@ -0,0 +1,56 @@ + +c=============================================================================== +c MAP_DEF_L1.INC +c=============================================================================== + +c in diesem File sind die notwendigen Groessen und Speicher fuer die Integration +c der Teilchenbahnen im Bereich der Linse 1 mittels des Programms 'MUTRACK' +c niedergelegt: + +c general items: +c (also known in some other parts of the program via include file +c 'COM_KAMMER.INC') + + real Beschl_Faktor + COMMON /Beschl_Faktor_L1/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + real xCenterOfLense + real xEnterMap + real xLeaveMap + + COMMON /integration_L1/ MappenName,dl_max,xCenterOfLense,xEnterMap,xLeaveMap + + real DistanceCyl + real iRadiusCyl + real LengthOuterCyl + real oRadiusOuterCyl + real LengthInnerCyl + real oRadiusInnerCyl + real RadiusVacTube + + COMMON /integration_L1/ DistanceCyl,iRadiusCyl + COMMON /integration_L1/ LengthOuterCyl,oRadiusOuterCyl + COMMON /integration_L1/ LengthInnerCyl,oRadiusInnerCyl + COMMON /integration_L1/ RadiusVacTube + + +c the grid characteristics: + + real Dx,Dr + integer imax,jmax + real xmax,rmax + + COMMON /integration_L1/ Dx,Dr,imax,jmax,xmax,rmax + + +c the map: + + integer maxmem + parameter (maxmem = 13133) + real map(0:maxmem) + + COMMON /integration_L1/ map + diff --git a/mutrack/src/MAP_DEF_L2ANDFO.INC b/mutrack/src/MAP_DEF_L2ANDFO.INC new file mode 100644 index 0000000..02bc95c --- /dev/null +++ b/mutrack/src/MAP_DEF_L2ANDFO.INC @@ -0,0 +1,66 @@ + +c=============================================================================== +c MAP_DEF_L2andFo.INC +c=============================================================================== + +c in diesem File sind die notwendigen Groessen und Speicher fuer die Integration +c der Teilchenbahnen im Bereich der Linse 2 bis zur Folie des Triggerdetektors +c mittels des Programms 'MUTRACK' niedergelegt: + +c general items: +c (also known in some other parts of the program via include file +c 'COM_KAMMER.INC') + + real Beschl_Faktor + COMMON /Beschl_Faktor/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + real xCenterOfLense + real xEnterMap + real xLeaveMap,xEndLense + + COMMON /integration_L2andFo/ MappenName,dl_max, + + xCenterOfLense,xEndLense,xEnterMap,xLeaveMap + + real DistanceCyl + real iRadiusCyl + real LengthOuterCyl + real oRadiusOuterCyl + real LengthInnerCyl + real oRadiusInnerCyl + real RadiusVacTube + + COMMON /integration_L2andFo/ DistanceCyl,iRadiusCyl + COMMON /integration_L2andFo/ LengthOuterCyl,oRadiusOuterCyl + COMMON /integration_L2andFo/ LengthInnerCyl,oRadiusInnerCyl + COMMON /integration_L2andFo/ RadiusVacTube + + +c the grid characteristics: + + real Dx,Dr + integer imax,jmax + real xmax,rmax + + COMMON /integration_L2andFo/ Dx,Dr,imax,jmax,xmax,rmax + + +c der Uebergabebereich am MappenEnde: + + real xStartUeber + real xEndUeber + + COMMON /integration_L2andFo/ xStartUeber,xEndUeber + + +c the map: + + integer maxmem + parameter (maxmem = 26143) + real map(0:maxmem) + + COMMON /integration_L2andFo/ map + + diff --git a/mutrack/src/MAP_DEF_L3.INC b/mutrack/src/MAP_DEF_L3.INC new file mode 100644 index 0000000..b33f17c --- /dev/null +++ b/mutrack/src/MAP_DEF_L3.INC @@ -0,0 +1,60 @@ + +c=============================================================================== +c MAP_DEF_L3.INC +c=============================================================================== + +c in diesem File sind die notwendigen Groessen und Speicher fuer die Integration +c der Teilchenbahnen im Bereich der Linse 3 mittels des Programms 'MUTRACK' +c niedergelegt: + +c general items: +c (also known in some other parts of the program via include file +c 'COM_KAMMER.INC') + + real Beschl_Faktor + COMMON /Beschl_Faktor_L3/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + real xCenterOfLense + real xEnterMap + real xLeaveMap + + COMMON /integration_L3/ MappenName,dl_max,xCenterOfLense,xEnterMap,xLeaveMap + + real DistanceCyl + real iRadiusCyl + real LengthOuterCyl + real oRadiusOuterCyl + real LengthInnerCyl + real oRadiusInnerCyl + real RadiusVacTube + + COMMON /integration_L3/ DistanceCyl,iRadiusCyl + COMMON /integration_L3/ LengthOuterCyl,oRadiusOuterCyl + COMMON /integration_L3/ LengthInnerCyl,oRadiusInnerCyl + COMMON /integration_L3/ RadiusVacTube + + +c the grid characteristics: + + real Dx,Dr + integer imax,jmax + real xmax,rmax + + COMMON /integration_L3/ Dx,Dr,imax,jmax,xmax,rmax + + +c the map: + + integer maxmem + parameter (maxmem = 75586) +c parameter (maxmem = 22320) +c parameter (maxmem = 20301) +c parameter (maxmem = 7523) + real map(0:maxmem) + + COMMON /integration_L3/ map + + diff --git a/mutrack/src/MAP_DEF_M2.INC b/mutrack/src/MAP_DEF_M2.INC new file mode 100644 index 0000000..d69c5e5 --- /dev/null +++ b/mutrack/src/MAP_DEF_M2.INC @@ -0,0 +1,51 @@ + +c=============================================================================== +c MAP_DEF_M2.INC +c=============================================================================== + +c in diesem File sind die notwendigen Groessen und Speicher fuer die Integration +c der Teilchenbahnen im Bereich vor dem MCP2 mittels des Programms 'MUTRACK' +c niedergelegt: + +c general items: +c (also known in some other parts of the program via include file +c 'COM_KAMMER.INC') + + real Beschl_Faktor + COMMON /Beschl_Faktor_M2/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + real xMCP2 + real xEnterMap + real radius_MCP2 + + COMMON /integration_M2/ MappenName,dl_max,xMCP2,xEnterMap,radius_MCP2 + + +c the grid characteristics: + + real Dx,Dr + integer imax,jmax + real xmax,rmax + + COMMON /integration_M2/ Dx,Dr,imax,jmax,xmax,rmax + + +c der Uebergabebereich am MappenEnde: + + real xStartUeber + real xEndUeber + + COMMON /integration_M2/ xStartUeber,xEndUeber + + +c the map: + + integer maxmem + parameter (maxmem = 38504) + real map(0:maxmem) + + COMMON /integration_M2/ map + diff --git a/mutrack/src/MAP_DEF_SP_1.INC b/mutrack/src/MAP_DEF_SP_1.INC new file mode 100644 index 0000000..1748eac --- /dev/null +++ b/mutrack/src/MAP_DEF_SP_1.INC @@ -0,0 +1,38 @@ + +c=============================================================================== +c MAP_DEF_SP_1.INC +c=============================================================================== + + real Beschl_Faktor + COMMON /Beschl_Faktor_SP/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + COMMON /integration_SP/ MappenName,dl_max + + real xSpGrid1,xSpGrid2 ! Gitterpositionen innerhalb der Mappe [mm] + real DSpiegel ! Abstand der Spiegelgitter + real dWires_Sp ! Drahtdurchmesser + real dist_Wires_Sp ! Drahtabstand + COMMON /integration_Sp/ xSpGrid1,xSpGrid2,DSpiegel, + * dWires_Sp,dist_Wires_Sp + + +c the grid characteristics: + + real Dx,Dy + integer imax,jmax + real xmin,xmax,ymax + + COMMON /integration_SP_1/ xmin,xmax,ymax,Dx,Dy,imax,jmax + + +c the map: + + integer maxmem + parameter (maxmem = 3684) + real map(0:maxmem) + + COMMON /integration_SP_1/ map + diff --git a/mutrack/src/MAP_DEF_SP_2.INC b/mutrack/src/MAP_DEF_SP_2.INC new file mode 100644 index 0000000..c51ddef --- /dev/null +++ b/mutrack/src/MAP_DEF_SP_2.INC @@ -0,0 +1,32 @@ + +c=============================================================================== +c MAP_DEF_SP_2.INC +c=============================================================================== + + real Beschl_Faktor + COMMON /Beschl_Faktor_SP/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + COMMON /integration_SP/ MappenName,dl_max + + +c the grid characteristics: + + real Dx,Dy + integer imax,jmax + real xmin,xmax,ymax + + COMMON /integration_SP_2/ xmin,xmax,ymax,Dx,Dy,imax,jmax + + +c the map: + + integer maxmem + parameter (maxmem = 8420) + real map(0:maxmem) + + COMMON /integration_SP_2/ map + + diff --git a/mutrack/src/MAP_DEF_SP_3.INC b/mutrack/src/MAP_DEF_SP_3.INC new file mode 100644 index 0000000..23dd844 --- /dev/null +++ b/mutrack/src/MAP_DEF_SP_3.INC @@ -0,0 +1,32 @@ + +c=============================================================================== +c MAP_DEF_SP_3.INC +c=============================================================================== + + real Beschl_Faktor + COMMON /Beschl_Faktor_SP/ Beschl_Faktor + + character*40 MappenName + real dl_max ! naeherungsweise Obergrenze fuer die einzelnen + ! Schrittlaengen: + COMMON /integration_SP/ MappenName,dl_max + + +c the grid characteristics: + + real Dx,Dy + integer imax,jmax + real xmin,xmax,ymax + + COMMON /integration_SP_3/ xmin,xmax,ymax,Dx,Dy,imax,jmax + + +c the map: + + integer maxmem + parameter (maxmem = 6600) + real map(0:maxmem) + + COMMON /integration_SP_3/ map + + diff --git a/mutrack/src/MUTRACK.FOR b/mutrack/src/MUTRACK.FOR new file mode 100644 index 0000000..5e8635e --- /dev/null +++ b/mutrack/src/MUTRACK.FOR @@ -0,0 +1,5466 @@ +c +c------------------------------------------------------------------------------ +c +c Changes starting on 17-Oct-2000, TP, PSI +c +c - add position of muons at TD foil and position of +c foil electrons when hitting MCP3 to NTuple +c - start changes for migration to NT and Unix; avoid using +c logicals or environment variables; cancel OPTIONS/EXTEND_SOURCE; +c use lower case filenames always +c +c****************************************************************************** +c* ... MUTRACK.FOR (Stand: Februar '96) * +c* * +c* Dieses Programm integriert Teilchenbahnen in der UHV-Kammer der NEMU- * +c* Apparatur. Startpunkte koennen zwischen der Moderatorfolie und dem MCP2 * +c* frei gewaehlt werden, Endpunkt der Berechnungen ist (sofern die Teilchen * +c* nicht vorher schon ausscheiden) die Ebene des MCP2. Bis jetzt koennen * +c* also nur Bewegungen in Strahlrichtung, nicht entgegen derselben berechnet * +c* werden. * +c* Das Programm selbst rechnet den zweistufigen Beschleuniger als ideal, * +c* bietet aber die Moeglichkeit Simulationen von TP oder AH (Programm 'Accel')* +c* mit realem Beschleuniger einzulesen. Die Integration der Teilchenbahnen * +c* erstreckt sich bei diesen Simulationen bis etwa zum He-Schild, MUTRACK * +c* rechnet dann von dort aus weiter. * +c* Verschiedene Einstellungen koennen in ineinandergreifenden Schleifen in * +c* aequidistanten Schritten variiert werden (z.B. Spannungen des Transport- * +c* Systems, Startgroessen der Teilchen, Masse und Ladung ...). Ein Teil dieser* +c* Groessen kann aber auch alternativ nach verschiedenen frei waehlbaren * +c* Zufallsverteilungen gewurfelt werden. * +c* Die Integrationsergebnisse koennen in der Form von NTupeln abgespeichert * +c* werden, was sie der Darstellung und Auswertung mit dem CERN-Programm PAW * +c* zugaenglich macht. * +c* Neben der reinen Integrationsarbeit fuehrt Mutrack Statistiken ueber * +c* verschiedene Groessen (z.Z. verschiedene Flugzeiten und Ortsverteilungen) * +c* die Mittelwerte und Standandartabweichungen sowie Minimal- und Maximalwerte* +c* umfassen. * +c* Diese Groessen koennen einfach ausgegeben oder in einem Tabellenfile abge- * +c* speichert werden, welches von PHYSICA mittels der Fortran-Routine * +c* 'READ_DATA' eingelesen werden kann. Verschiedene PHYSICA-Makros * +c* (.PCM-files) ermoeglichen dann die Darstellung dieser statistischen * +c* Groessen in Form von 2D- und 3D-Graphiken. (z.B. Abhaengigkeit der Trans- * +c* mission von HV-Settings des Transportsystems). * +c* Die momentan vorhandenen Routinen heissen * +c* * +c* MUINIT.PCM * +c* HELP.PCM * +c* MUPLOT_1DIM.PCM * +c* MUPLOT_2DIM.PCM * +c* TYPE_LOGHEADER.PCM * +c* TYPE_PARAMS_GRAPHIC.PCM * +c* TYPE_PARAMS_TEXT.PCM * +c* * +c* Nach dem Start (von dem Directory aus, in dem obige Routinen abgelegt sind)* +c* muss PHYSICA mit dem Befehl '@MUINIT' initialisiert werden. Danach koennen * +c* obige Routinen ueber Aliasse angesprochen werden. Weitere Informationen * +c* hierzu erhaelt man, indem man in PHYSICA nach der Initialisierung 'MUHELP' * +c* eingibt. * +c* Der Sourcecode fuer Mutrack ist ueber verschiedene .FOR-Dateien verteilt, * +c* die jeweils zu einem Problembereich gehoerige Subroutinen enthalten. Die * +c* zur Zeit vorhandenen Files und die darin enthaltenen Routinen sind: +c* +c* MUTRACK.FOR +c* SUB_ARTLIST.FOR +c* SUB_OUTPUT.FOR +c* SUB_INPUT.FOR +c* SUB_INTEGR_FO.FOR +c* SUB_INTEGR_L1.FOR +c* SUB_INTEGR_L3.FOR +c* SUB_INTEGR_M2.FOR +c* SUB_PICTURE.FOR +c* SUB_TRIGGER.FOR +c* +c* +c* Includefiles mit COMMON-Blöcken: +c* +c* COM_DIRS.INC +c* COM_KAMMER.INC +c* COM_LUNS.INC +c* COM_MUTRACK.INC +c* COM_OUTPUT.INC +c* COM_TD_EXT.INC +c* COM_TD_INT.INC +c* COM_WINKEL.INC +c* GEO_KAMMER.INPUT +c* GEO_TRIGGER.INC +c* +c* +c* Icludefile mit Defaultwerten fuer eine Reihe benutzerdefinierbarer und Programm- +c* interner Groessen: +c* +c* INITIALIZE.INC +c* +c* +c* Includefiles fuer die Potentialmappen: +c* +c* MAP_DEF_FO.INC +c* MAP_DEF_L1.INC +c* MAP_DEF_L3.INC +c* MAP_DEF_M2.INC +c* +c* READ_MAP.INC +c* +c* +c* Benoetigte Eingabfiles: +c* +c* MUTRACK.INPUT (fuer die Integrationen zu verwendende Einstellungen) +c* kammer_geo.INPUT (Spezifizierung der Kammergeometrie) +c* mappenName.INFO (Dateien mit Angaben ueber zugehoerige Potentialmappen) +c* mappenName.MAPPE (die Potentialmappen) +c* MUTRACK_NR.DAT (zuletzt vergebene Nummern der Ausgabedateien, wird +c* von Mutrack verwaltet). +c* +c* +c* Fuer die Erstellung der Potentialmappen mit dem Triumf-Programm stehen folgende +c* Hilfsmittel zur Verfuegung: +c* +c* BESCHL-INIT.FOR +c* LENSE-INIT.FOR +c* +c* Diese Boundary-Routinen stellen folgende Moeglichkeiten zur Verfuegung: +c* +c* Initialisierung von Scratch, von 2D und von 3D-Mappen. Kontrollmoeglichkeiten +c* ueber die Ausgabe der Potentialbereiche. +c* +c* Die Mappen koennen von PHYSICA aus mittels der FORTRAN-Routine ' ' +c* und den .PCM-Makros ' ' ... angeschaut und ausgegeben werden. +c* +c* +c* +c* Liste der moeglichen Ausgabefiles: +c* +c* MU_nnnn.LOG +c* MU_nnnn.GEO +c* MU_nnnn.PHYSICA +c* MU_nnnn.NTP +c* MU_nnnn._tab +c* +c* Diese Version von MUTRACK enthaelt nur noch rudimentaere Anteile des ursprueng- +c* lichen Programmes von Thomas Wutzke. Hauptunterschiede und Erweiterungen sind: +c* +c* # Ersetzen der Euler-Integration durch ein schrittweitenkontrolliertes +c* Runge-Kutta Verfahren. Der dieser Implementation zugrundeliegende Algo- +c* rythmus entstammt dabei dem Buch 'NUMERICAL RECIPES, The Art of Scientific +c* Computing' (Fortran Version) von Press, Flannery, Teukolsky und Vetterling, +c* Cambridge University Press (1989). +c* +c* # Verbesserter Algorythmus zur Berechnung der Feldstaerken aus den Potential- +c* Mappen. +c* +c* # Implementierung des gesamten Statistikaparates. (Zuvor waren PAW-Ntupel die +c* einzige Ausgabeform abgesehen von den Debuginformationen). +c* +c* # Uebersichtlichere Gestalltung der Ein- und Ausgabe, sowie der Debug-Infos. +c* +c* # Implementierung der Moeglichkeit, verschiedenen Parameter in Schleifen zu +c* durchlaufen. +c* +c* # Implementierung der fuer die graphische Darstellung mit PHYSICA notwendigen +c* Routinen. +c* +c* # Implementierung des Triggerdetektors. +c* +c* # Implementierung der Graphikausgabe der Teilchenbahnen (diese Routinen wurden +c* in ihrer ersten Fassung von Michael Birke geschrieben). +c* +c* # Umstellen der Potentialmappen auf 'unformattiert' und Einschraenken der +c* Mappen auf den wirklich benoetigten Bereich (d.h. z.B. Ausnutzen der +c* Symmetrie der Linsen, wodurch die Mappengroesse bei den Linsen mehr als +c* halbiert werden konnte. +c* +c* # Implementierung der Moeglichkeit, die Kammergeometrie (d.h. die Positionen +c* der verwendeten Elemente) sowie die Potentialmappen (z.B. fuer unter- +c* schiedliche Linsenkonfigurationen) ueber ein .INPUT-Eingabefile ohne +c* Umschreiben des Sourcecodes aendern zu koennen. +c* +c* Das Programm verwendet fuer Graphikdarstellung und NTupel-Erzeugung Routinen der +c* zum PAW-Komplex gehoerenden CERN-Bibliotheken 'HPLOT' und 'HBOOK'. +c* +c* Am Anfang der Deatei 'COM_MUTRACK.INC' findet sich eine Liste der wichtigsten +c* Aenderungen ueber die verschiedenen Versionen ab 1.4.1. +c* +c* Gruss, Anselm Hofer +c****************************************************************************** +c + +C =============== + program MUTRACK +C =============== + +c Deklarationen: + + Implicit None + + INCLUDE 'com_mutrack.inc' + INCLUDE 'com_dirs.inc' + INCLUDE 'com_td_ext.inc' + INCLUDE 'com_winkel.inc' + INCLUDE 'com_kammer.inc' + INCLUDE 'geo_trigger.inc' + + +c die SCHLEIFENVARIABLEN fuer die 'do 200 ...'-Schleifenund und damit +c zusammenhaengendes (Common-Bloecke werden fuer die NTupel-Ausgabe benoetigt): + +c - 'virtuelle' Flugstreckenverlaengerungen: + + real delta_L1,delta_L2 + +c - Energieverlust in der Triggerfolie und Dicke derselben: + + real E_loss + +c - Drehwinkel: +c (alfaTgt, alfaSp, alfaTD und ihre Winkelfunktionen werden in 'COM_WINKEL.INC' +c erledigt: COMMON /ANGELS/) + + real y_intersectSP ! Benoetigt fuer Schnittpkt. der Trajektorie + real yUppLeft, yLowLeft ! mit forderer Spiegelebene + + real x_intersectTD ! Benoetigt fuer Schnittpkt. der Trajektorie + ! mit TD-Folie + real x_intersectTDMap ! ... mit TD-Mappe + common /x_intersectTD/ x_intersectTD,x_intersectTDMap + +c - Masse und Ladung: + + real m, m_ ! Masse, Laufvariable fuer Massen-Schleife + real q, q_ ! Ladung, Laufvariable fuer Ladungs-Schleife + integer qInt + COMMON /charge/ qInt ! fuer 'NTP_charge' + + integer nNeutral,nCharged ! fuer Ausgabe des gewuerfelten neutralen anteils + COMMON /nNeutral/ nNeutral,nCharged + +c - MCP2: + + real U_MCP2 ! Spannung am MCP2 + + +c - Triggerdetektor: U_F, U_V, U_H und U_MCP3 werden in 'COM_TD_EXT.INC' +c erledigt. (COMMON /TRIGGERSETTINGS/) + +c - Transportsystem: + + real U_Tgt ! Target-Spannung + real U_Gua ! Spannung am Guardring + real U_G1 ! Spannung am ersten Gitter + real U_L1 ! Spannung an Linse 1 + real U_Sp ! Spiegelspannung + real U_L2 ! Spannung an Linse 2 + real U_L3 ! Spannung an Linse 3 + + COMMON /U_L2/ U_L2 ! fuer die Addition der 'L2andFo'-Mappe + + real last_U_L2 / -1.E10 / ! fuer die Addition der 'L2andFo'-Mappe + real last_U_F / -1.E10 / + +c - Magnetfeldstaerken: + + real B_Helm ! Magnetfeld der Helmholtzspulen + real B_TD ! Magnetfeld der Kompensationsspule am TD + +c - Startparameter: + + integer randomloop_ ! Laufvariable fuer zufallsverteilte Starts + real E0_ ! Laufvariable fuer Startenergie_Schleife + real theta0_ ! Laufvarialbe fuer Startwinkel-Schleife + real Sin_theta0, Cos_theta0 ! Startwinkel gegen x-Achse + real phi0_ ! Laufvariable fuer Startwinkel-Schleife + real Sin_phi0, Cos_phi0 ! azimuthaler Startwinkel (phi0=0: y-Achse) + real y0_ ! Laufvariable fuer Startpositions_Schleife + real z0_ ! Laufvariable fuer Startpositions_Schleife + real r0 ! Radius beim Wuerfeln der Startposition + real phi_r0 ! Winkel beim Wuerfeln der Startposition + + ! x0(3),v0(3),E0,theta0,phi0 werden in 'COM_MUTRACK.INC' declariert + + +c allgemeine Trajektoriengroessen + + real dt ! zeitl. Aenderung + real v_xy ! Geschwindigkeit in x/y-Ebene + real v_square, v0_Betrag, v_Betrag + real Ekin ! kinetische Energie + real a1,a2 ! Beschleunigung in 1. bzw. 2. Beschl.Stufe + real aFoil ! Beschleunigung zwischen Massegitter und Folie + real radiusQuad ! RadiusQuadrat + real radiusQuad_ ! RadiusQuadrat + real radius + + real S1xM2 ! Zeit vom Start bis zur MCP2-Ebene + real S1M2 ! Zeit vom Start bis zum MCP2 (Treffer voarausgesetzt) + real S1Fo ! Zeit vom Start bis zur Folie + real S1FoOnly ! Zeit vom Start bis zur Folie + real FoM2 ! Zeit zwischen Folie und MCP2 + real FoM2Only ! wie FoM2, falls keine anderen TOFs verlangt + real S1M3 ! Zeit vom Start bis Eintreffen der FE auf MCP3 + real M3M2 ! Zeit vom Eintreffen der FE auf MCP3 bis MCP2 + + real alfa ! Bahnwinkel gegen die Triggerfolienebene + real E_Verlust /0./ ! Energieverlust in der Folie + real delta_E_Verlust ! Streuung des Energieverlustes in der Folie + real thetaAufstreu ! Ablenkung aus vorheriger Richtung in der Folie + real phiAufstreu ! azimuthaler Winkel der Ablenkung gegenueber Horiz. + COMMON /FOLIE/ E_Verlust,thetaAufstreu,phiAufstreu + + real Beschl_Faktor ! Faktor bei Berechn. der Beschleunigung im EFeld + COMMON /BESCHL_FAKTOR/ Beschl_Faktor + + real length1 ! = d_Folie_Achse + MappenLaenge_FO + real length2 ! = xTD - d_Folie_Achse - MappenLaenge_FO ! = xTD-length1 + + +c Groessen der Folienelektronen ('FE'): + + integer nFE ! jeweilige Anzahl an FE (2 <= nFE <= 5) + real E0FE ! Startenergie der Folienelektronen + real ct0,st0,cf0,sf0 ! die Winkelfunktionen der Startwinkel der FE + real f0 ! 'phi0' fuer die FE + real x0FE(3) ! Startort der Folienelektronen auf der TD-Folie + real xFE(3),vFE(3) ! Ort und Geschw. der FE + real tFE ! Zeit + real tFE_min ! kuerzeste gueltige FE-Flugzeit je Projektil + integer tFE_(5) /-1,-1,-1,-1,-1/ ! Flugzeit jedes FE in ps (fuer NTP) +c +c---------------- +c +c-TP-10/2000 add variables to have position information of muons at +c TD and FE at MCP3 in NTuple; up to 5 electrons possible +c + real xFE_MCP(5), yFE_MCP(5), zFE_MCP(5) + common /TrigDet/ x0FE, xFE_MCP, yFE_MCP, zFE_MCP +c +c---------------- +c + COMMON /S1xM2/ S1xM2 ! fuer NTupel + COMMON /TIMES/ S1M2,S1Fo,FoM2,S1M3,M3M2,tFE_ ! fuer NTupel + common /FoM2Only/ FoM2Only + COMMON /S1FoOnly/ S1FoOnly + +c Variablen fuer den allgemeinen Programmablauf: + + integer qIndxMu + common /qIndxMu/ qIndxMu + + integer ntpid(1) ! fuer das Einlesen des NTupels von ACCEL oder von + integer ntpnr ! FoilFile + + integer firstEventNr + external firstEventNr + + logical NTPalreadyWritten + + real Spiegel_Faktor ! Faktor bei Berechn. der Reflektionszeit im Spiegel + + integer bis_Spiegel ! verschiedene Label + integer bis_L3_Mappe, bis_MCP2_Mappe, MCP2_Mappe + + character uhrzeit*8 + + integer percent_done + logical fill_NTP + + real radiusQuad_HeShield + real radiusQuad_LNShield + real radiusQuad_L1 + real radiusQuad_L2 + real radiusQuad_L3 + real radiusQuad_Blende + real radiusQuad_Rohr + real radiusQuad_MCP2 ! Radiusquadrat des MCP2 + real radiusQuad_MCP2active ! Radiusquadrat der aktiven Flaeche des MCP2 + real radiusQuad_Sp ! Radiusquadrat der Spiegeldraehte + real rWires_Sp ! Radius der Spiegeldraehte + + logical check_Blende /.false./ + + real xChangeKoord ! legt den Ort nach dem Spiegel fest, bei + parameter (xChangeKoord = 75.) ! dem das Koordinatensystem gewechselt wird + + integer n_return ! die Returnvariable fuer Aufruf von 'TD_CALC' + integer zaehler ! Zaehler fuer Monitoring der Trajektorie in den + ! Gebieten, in denen stepwise integriert werden + ! muss + logical flag, flag_ok + integer okStepsCounter + + integer i, k ! integer-Hilfsvariablen + real help1, help2 ! real-Hilfsvariablen + real help3, help4 ! real-Hilfsvariablen + + real YieldPlus,YieldNeutral ! Ladungsanteile nach TD-Foliendurchgang + + integer startLabel ! das Einsprunglabel beim Teilchenstart + + character helpChar*7, ant*1 + character HistogramTitle*32 /'Schnitt bei x = (i. Teil)'/ + +d real dtmin_L1, dtmin_Sp, dtmin_L2andFo, dtmin_FO, dtmin_L3, dtmin_M2 +d real dtmax_L1, dtmax_Sp, dtmax_L2andFo, dtmax_FO, dtmax_L3, dtmax_M2 +d real x_dtmin_L1(3), x_dtmax_L1(3), x_dtmin_FO(3), x_dtmax_FO(3) +d real x_dtmin_L2andFo(3), x_dtmax_L2andFo(3) +d real x_dtmin_L3(3), x_dtmax_L3(3), x_dtmin_M2(3), x_dtmax_M2(3) +d real x_dtmin_Sp(3), x_dtmax_Sp(3) +d +d ! /ntp_steps/ enthaelt auch 'steps' (ueber COM-MUTRACK.INC) +d COMMON /ntp_steps/ dtmin_L1, x_dtmin_L1, dtmax_L1, x_dtmax_L1, +d + dtmin_Sp, x_dtmin_Sp, dtmax_Sp, x_dtmax_Sp, +d + dtmin_L2andFo, x_dtmin_L2andFo, dtmax_L2andFo, x_dtmax_L2andFo, +d + dtmin_FO, x_dtmin_FO, dtmax_FO, x_dtmax_FO, +d + dtmin_L3, x_dtmin_L3, dtmax_L3, x_dtmax_L3, +d + dtmin_M2, x_dtmin_M2, dtmax_M2, x_dtmax_M2 + + real x40(2:3),v40(3),t40,E40 ! Speicher fuer Trajektoriengroessen bei x=40mm + COMMON /NTP_40mm/ x40,v40,t40,E40 + +cMBc logical writeTraj2File +cMBc common /writeTraj2File/ writeTraj2File + + +c Variablen fuer Test ob Draht getroffen wurde: + + real distToWire(2) + integer DrahtNr + logical WireHit + + real WireRadiusQuad_G1,WireRadiusQuad_G2 + real WireRadiusQuad_Sp + + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000),xKoord_(1000) ! Koordinatenfelder fuer die + real yKoord(1000),yKoord_(1000) ! Graphikausgabe + real zKoord(1000),zKoord_(1000) ! +cMBc real tKoord(1000),tKoord_(1000) ! + integer nKoord,nKoordSave ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord + + +c Variablen fuer HBOOK und PAW: + + integer istat ! fuer HBOOK-Fehlermeldungen + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory ! Der Arbeitsbereich fuer HBOOK + + +c Konstanten: + + real c ! Lichtgeschwindigkeit in mm/ns + real meanLifeTime ! mittlere Myon-Lebensdauer in ns + + parameter (c = 299.7925, meanLifeTime = 2197) + +c------------------------------------------------------------------------------- +c Konstanten und Variable fuer Berechnung der Winkelaufstreuung in Triggerfolie +c mittels Meyer-Formel (L.Meyer, phys.stat.sol. (b) 44, 253 (1971)): + + real g1, g2 ! Tabellierte Funktionen der Referenz + real effRedThick ! effektive reduzierte Dicke ('tau' der Referenz) + + +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target + real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + real HWHM2sigma ! Umrechnungsfaktor von (halber!) Halbwertsbreite + ! nach Sigma der Gaussfunktion + + real Na ! die Avogadrokonstante + real mMolC ! molare Masse von C in ug + real Pi ! die Kreiszahl + + parameter (Z1 = 1, Z2 = 6, a0 = 5.29E-9, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10, HWHM2sigma = 1./1.17741) + parameter (Na = 6.022e23, mMolC = 12.011e6, Pi = 3.141592654) + + +c - Bei der Berechnung von Sigma auftretende Vorfaktoren. +c (Meyer_faktor 1 wird benoetigt fuer Berechnung der reduzierten Dicke aus der +c 'ug/cm2'-Angabe der Foliendicke. Meyer_faktor2 und Meyer_faktor3 werden +c direkt fuer die Berechnung von sigma aus den beiden tabellierten Funktionen +c g1 und g2 verwendet): + + real Meyer_Faktor1, Meyer_Faktor2, Meyer_Faktor3 + + parameter (Meyer_faktor1 = Pi*screeningPar*screeningPar * Na/mMolC) + ! Na/mMolC = 1/m(C-Atom) + parameter (Meyer_faktor2 = (2*Z1*Z2 * eSquare)/ScreeningPar * 180./Pi + + * HWHM2sigma) + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + + +c------------------------------------------------------------------------------- +c Kommentar zur Berechnung der Winkelaufstreuung nach Meyer: +c +c Als Bedingung fuer die Gueltigkeit der Rechnung wird verlangt, dass +c +c (1) die Anzahl n der Stoesse >> 20*(a/r0)^(4/3) sein muss. Fuer Protonen auf +c Graphit ist laut Referenz a/r0 gleich 0.26 (mit Dichte von 3.5 g/ccm habe +c ich einen Wert von 0.29 abgeschaetzt). Fuer Myonen hat man den selben +c Wert zu nehmen. Damit ergibt sich die Forderung, dass n >> 3.5 sein muss. +c +c (2) unabhaengig von (1) n >> 5 sein muss, was (1) also mit einschliesst. +c +c Mit n = Pi*r0*r0*Teilchen/Flaeche ergibt sich fuer eine Foliendicke von +c 3 ug/cm^2 als Abschaetzung fuer n ein Wert von 37. (r0 ueber r0 = 0.5 N^(1/3) +c und 3.5 g/ccm zu 8.9e-9 cm abgeschaetzt). D.h., dass die Bedingungen in +c unserem Fall gut erfuellt sind. +c In dem Paper wird eine Formel fuer Halbwertsbreiten angegeben. Ich habe nicht +c kontrolliert, in wie weit die Form der Verteilung tatsaechlich einer Gauss- +c verteilung entspricht. Zumindest im Bereich der Vorwaertsstreuung sollte +c die in diesem Programm verwendete Gaussverteilung aber eine sehr gute +c Naeherung abgeben. Abweichungen bei groesseren Winkeln koennten jedoch u. U. +c die absolute Streuintensitaet in Vorwaertsrichtung verfaelschen. + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER GEHT DER PROGRAMMTEXT RICHTIG LOS +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c Initialisierungen: + + INCLUDE 'initialize.inc' + + +c Einlesen der Parameter aus 'MUTRACK.INPUT' und Setzen der entsprechenden +c Voreinstellungen. Einlesen der Kammergeometrie sowie der INFO-files der +c Feldmappen: + + call read_inputFile + + +c Berechnen der RadiusQuadrate: + + radiusQuad_HeShield = rHeShield*rHeShield + radiusQuad_LNShield = rLNShield*rLNShield + radiusQuad_Rohr = radius_Rohr*radius_Rohr + radiusQuad_L1 = iRadiusCyl_L1*iRadiusCyl_L1 + radiusQuad_L2 = iRadiusCyl_L2*iRadiusCyl_L2 + radiusQuad_L3 = iRadiusCyl_L3*iRadiusCyl_L3 + radiusQuad_Blende = radius_Blende*radius_Blende + radiusQuad_MCP2 = radius_MCP2*radius_MCP2 + radiusQuad_MCP2active = radius_MCP2active*radius_MCP2active + WireRadiusQuad_G1 = dWires_G1/2. * dWires_G1/2. + WireRadiusQuad_G2 = dWires_G2/2. * dWires_G2/2. + WireRadiusQuad_Sp = dWires_Sp/2. * dWires_Sp/2. + rWires_Sp = dWires_Sp/2. + radiusQuad_Sp = rWires_Sp * rWires_Sp + + +c Einlesen der Feldmappen: + + write(*,*)'----------------------------------------'// + + '----------------------------------------' + if (.NOT.(par(1,UL1).EQ.0. .AND. n_par(UL1).LE.1)) call READ_MAP_L1 + + if (.NOT.(idealMirror .OR. (par(1,USp).EQ.0. .AND. n_par(USp).LE.1))) then + call read_Map_SP_1 + call read_Map_SP_2 + call read_Map_SP_3 + endif + + if (TriggerInBeam .AND. .NOT.lense2 .AND. + ! 'lense2' muss noch in sub_input richtig gesetzt werden! (-> foilfile) + + .NOT.(par(1,UFolie).EQ.0. .AND. n_par(UFolie).LE.1) ) then + call READ_MAP_FO + endif + + if (.NOT.(par(1,UL3).EQ.0. .AND. n_par(UL3).LE.1)) then + if (.NOT.(par(1,UMCP2).EQ.0. .AND. n_par(UMCP2).LE.1)) then + if (xLeaveMap_L3.GT.xEnterMap_M2) then + write(*,*) + write(*,*)' Potentialmappen von Linse 3 und MCP2 ueberlappen!' + write(*,*)' Dies ist in der aktuellen Implementierung des Programmes' + write(*,*)' nicht vorgesehen!' + write(*,*) + write(*,*)' -> STOP' + write(*,*) + STOP + endif + endif + call READ_MAP_L3 + endif + + if (.NOT.(par(1,UMCP2).EQ.0. .AND. n_par(UMCP2).LE.1)) call READ_MAP_M2 + + +c Eingelesene Simulationsparameter auf Schirm geben und bestaetigen lassen. +c Die Ausgabefiles initialisieren: + + call initialize_output + + +c falls ein 'FoilFile' erstellt werden soll, schreibe das .INFO-files: + + if (createFoilFile) call make_INFOFile + if (Use_MUTRACK) Use_ACCEL = .false. + + +c Defaultwert fuer 'fill_NTP' setzen (wird weiter unten ueberschrieben, falls +c fuer das Fuellen des NTupels spezielle Triggerbedingung verlangt ist): + + if (createNTP) then + fill_NTP = .true. + else + fill_NTP = .false. + endif + + +c CERN-Pakete initialisieren (Groesse des COMMONblocks PAWC uebermitteln): + + if (.NOT.fromScratch.OR.Graphics.OR.createNTP.OR.createFoilFile) call HLIMIT(HB_memsize) + + +c Graphikausgabe initialisieren: + + if (GRAPHICS) then + call masstab_setzen + CALL HPLSET ('VSIZ',.6) ! AXIS VALUES SIZE + write(HistogramTitle(17:22),'(F6.1)') schnitt_x + write(HistogramTitle(25:25),'(I1)') schnitt_p + CALL HPLSET ('TSIZ',.7) ! HISTOGRAM TITLE SIZE + CALL HBOOK2 (50,HistogramTitle,100,-30.,30.,100,-30.,30.,20.) + endif + + +c falls fruehere Simulation fortgefuehrt werden soll, oeffne entsprechende Datei: + + if (.NOT.fromScratch) then + if (use_ACCEL) then + call HROPEN(lunREAD,'ACCEL',ACCEL_Dir//':'//fileName_ACCEL//'.NTP', + + ' ',1024,istat) + else + call HROPEN(lunREAD,'MUread',outDir//':'//fileName_MUTRACK//'.NTP', + + ' ',1024,istat) + endif + + call HRIN(0,99999,0) + call HIDALL(ntpid,ntpNr) + call HDELET(ntpid(1)) + i = NTP_read - ntpid(1) + call HRIN(NTP_read-i,9999,i) ! NTP_read = NTP_write+1 + call HBNAME(NTP_read,' ',0,'$CLEAR') ! alles resetten + + ! fuer die benoetigten Bloecke des CWN die entsprechenden Speicher- + ! lokalisationen uebermitteln: + + if (random_E0) call HBNAME(NTP_read,'E0',E0,'$SET') + if (random_pos) call HBNAME(NTP_read,'x0',x0,'$SET') + if (random_angle) call HBNAME(NTP_read,'angle0',theta0,'$SET') ! theta0,phi0 + if (UseDecay_prevSim) call HBNAME(NTP_read,'lifetime',lifetime,'$SET') + + if (smearS1Fo .AND. use_MUTRACK) then + call HBNAME(NTP_read,'S1FoS',S1FoOnly,'$SET') + endif + + call HBNAME(NTP_read,'dest',gebiet,'$SET') ! gebiet,destiny + call HBNAME(NTP_read,'Traj',t,'$SET') ! t,x,v + + endif + + +c NTP-relevante Befehle: + +c BAD LUCK!!! Das Packen der Real-Variablen im folgenden hat KEINERLEI VER- +c KLEINERUNG DER FILEGROESSE bewirkt!!!! (fuer die Integers habe ich noch +c keinen Test gemacht). -> wohl besser wieder herausnehmen. Ich verliere +c u.U. nur Genauigkeit und habe nur einen eingeschraenkten Wertebereich zur +c Verfuegung! + + if (createNtp.OR.createFoilFile) then + + !c Datei fuer NTupelausgabe oeffnen: + call HROPEN(lunNTP,'MUwrite',outDir//':'//filename//'.NTP', + + 'N',1024,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)'error ',istat,' opening HBOOK-file' + write(*,*) + STOP + endif + + call HBNT(NTP_write,filename,'D') ! D: Disk resident CWN buchen + + !c die Bloecke des CWN definieren: + + if (.NOT.OneLoop) call HBNAME(NTP_write,'LOOP',schleifenNr,'loop[1,1000]:u') + if (M2_triggered .OR. Fo_triggered.AND.upToTDFoilOnly) then + ! -> Gebiet und Destiny stehen hier sowieso fest, nimm + ! diese Groessen daher erst gar nicht mehr in das NTupel auf! + else + call HBNAME(NTP_write,'DEST',gebiet,'Gebiet[0,20]:u,dest[-10,10]:i') + endif + if (NTP_Start .OR. createFoilFile.AND.random_pos) then + call HBNAME(NTP_write,'X0',x0,'x0,y0,z0') + endif + if (NTP_Start) call HBNAME(NTP_write,'V0',v0,'vx0,vy0,vz0') + if (NTP_Start .OR. createFoilFile.AND.random_E0) then + call HBNAME(NTP_write,'E0',E0,'E0') + endif + if (NTP_Start .OR. createFoilFile.AND.random_angle) then + call HBNAME(NTP_write,'ANGLE0',theta0,'theta0,phi0') + endif + if (NTP_lifetime .OR. createFoilFile.AND.UseDecay) then + call HBNAME(NTP_write,'LIFETIME',lifetime,'lifetime:r') + endif + if (NTP_40mm) call HBNAME(NTP_write,'X=40MM',x40, + + 'y40,z40,vx40,vy40,vz40,t40,E40') + if (NTP_S1xM2) call HBNAME(NTP_write,'S1xM2',S1xM2,'S1xM2') + if (NTP_Times) then + if (TriggerInBeam) then + if (generate_FE) then + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2,S1Fo,FoM2,S1M3,M3M2:r,TFE(5):i') + else + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2,S1Fo,FoM2') + endif + else + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2') + endif + endif + if (NTP_FoM2Only) then + call HBNAME(NTP_write,'FoM2',FoM2Only,'FoM2') + endif + if (NTP_Folie) then + call HBNAME(NTP_write,'FOLIE',E_Verlust, + + 'ELoss,thetStreu,phiStreu') +c +c-------------------------- +c +c-TP-10/2000 add position at foil and MCP3 (FE) +c + call HBNAME(NTP_write, 'TrigDet', x0FE, + + 'x0FE,y0FE,z0FE,xFE(5),yFE(5),zFE(5)') +c +c-------------------------- +c + endif + if (NTP_charge) call HBNAME(NTP_write,'CHARGE',qInt,'q[-5,5]:i') + if (NTP_stop.OR.createFoilFile) then + call HBNAME(NTP_write,'TRAJ',t,'t,x,y,z,vx,vy,vz') + endif +c if (createFoilFile .AND. smearS1Fo .AND. .NOT.NTP_times) then + if (smearS1Fo) then + call HBNAME(NTP_write,'S1FoS',S1FoOnly,'S1FoS') + endif + if (NTP_stop) then + call HBNAME(NTP_write,'EKIN',Ekin,'Ekin') + endif +d if (NTP_steps) then +d call HBNAME(NTP_write,'STEP',steps,'steps[1,100000]:u,'// +d + 'dtminL1, xdtminL1, ydtminL1, zdtminL1,'// +d + 'dtmaxL1, xdtmaxL1, ydtmaxL1, zdtmaxL1,'// +d + 'dtminL2, xdtminL2, ydtminL2, zdtminL2,'// +d + 'dtmaxL2, xdtmaxL2, ydtmaxL2, zdtmaxL2,'// +d + 'dtminFO, xdtminFO, ydtminFO, zdtminFO,'// +d + 'dtmaxFO, xdtmaxFO, ydtmaxFO, zdtmaxFO,'// +d + 'dtminL3, xdtminL3, ydtminL3, zdtminL3,'// +d + 'dtmaxL3, xdtmaxL3, ydtmaxL3, zdtmaxL3,'// +d + 'dtminM2, xdtminM2, ydtminM2, zdtminM2,'// +d + 'dtmaxM2, xdtmaxM2, ydtmaxM2, zdtmaxM2') +d endif + endif + + +c die Label definieren: + + assign 7 to bis_Spiegel + assign 14 to bis_L3_Mappe + assign 16 to bis_MCP2_Mappe + assign 17 to MCP2_Mappe + + +c die Einsprungposition fuer den Beginn der Trajektorienberechnungen setzen: + + if (Use_MUTRACK) then + assign 113 to startLabel + elseif (Use_ACCEL) then + assign 3 to startLabel + elseif (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + assign 1 to startLabel + elseif (Gebiet0.EQ.upToGrid2) then + assign 2 to startLabel + elseif (Gebiet0.EQ.upToHeShield) then + assign 3 to startLabel + elseif (Gebiet0.EQ.upToLNShield) then + assign 4 to startLabel + elseif (Gebiet0.EQ.upToL1Map) then + assign 5 to startLabel + elseif (Gebiet0.EQ.upToExL1) then + assign 6 to startLabel + elseif (Gebiet0.EQ.upToEnSp) then + assign 7 to startLabel + elseif (Gebiet0.EQ.upToExSp) then + assign 8 to startLabel + elseif (Gebiet0.EQ.upToChKoord) then + assign 9 to startLabel + elseif (Gebiet0.EQ.upToEnTD) then + assign 10 to startLabel + elseif (Gebiet0.EQ.upToExTD) then + if (log_alpha0_KS) then + assign 111 to startLabel + else + assign 112 to startLabel + endif + elseif (Gebiet0.EQ.upToL2andFoMap) then +c assign 12 to startLabel + elseif (Gebiet0.EQ.upToExL2) then +c assign 13 to startLabel + elseif (Gebiet0.EQ.upToL3Map) then + assign 12 to startLabel + elseif (Gebiet0.EQ.upToExL3) then + assign 13 to startLabel + elseif (Gebiet0.EQ.upToM2Map) then + assign 14 to startLabel + elseif (Gebiet0.EQ.upToMCP2) then + assign 15 to startLabel + endif + + +c Abkuerzungen 'Length1' und 'length2' setzen: + + length1 = d_Folie_Achse + MappenLaenge_FO + length2 = xTD - d_Folie_Achse - MappenLaenge_FO + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c ab hier beginnen die Schleifen: +c (Bemerkung: eine Laufvariable darf kein Feldelement sein!) +c +c Besonderheit der Massen- und der Ladungsschleife: +c Wurde im INPUT-File in der Variablen 'artList' eine Teilchenart spezifi- +c ziert (-> 'artList_defined'), so werden die Parameter Masse und Ladung nicht +c entsprechend den Inhalten von par(n,mass) bzw. par(n,charge) eingestellt, +c sondern entsprechend den zu den Teilchenarten gehoerenden Werten fuer diese +c Groessen. In diesem Fall besteht die Massenschleife aus genau einem (Leer-) +c Durchlauf, waehrend die Ladungsschleife fuer jede Teilchenart einen Durchlauf +c macht, in welcher dann die Einstellung von Ladung UND Masse stattfindet. +c +c Bei Aenderungen in der Abfolge der Schleifen muss die Anweisungszeile +c 'DATA reihenfolge /.../' in 'INITIALIZE.INC' entsprechend editiert werden! +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c zusaetliche Flugstrecken vor TD und MCP2 (gehen NUR in t, NICHT in x ein!!): +c ---------------------------------------------------------------------------- + + do 200 Delta_L1 = par(1,DeltaL1),par(2,DeltaL1),par(3,DeltaL1) + parWert(DeltaL1) = Delta_L1 + do 200 Delta_L2 = par(1,DeltaL2),par(2,DeltaL2),par(3,DeltaL2) + parWert(DeltaL2) = Delta_L2 + +c Foliendicke und Energieverlust: +c ------------------------------- + + do 200 E_loss = par(1,Eloss),par(2,Eloss),par(3,Eloss) ! Eloss + parWert(Eloss) = E_loss + mean_E_Verlust = E_loss + + do 200 Thickness = par(1,Thickn),par(2,Thickn),par(3,Thickn)! Thickness + parWert(Thickn) = Thickness + +c MCP2: +c ----- + + do 200 U_MCP2 = par(1,UMCP2),par(2,UMCP2),par(3,UMCP2) ! U(MCP2) + parWert(UMCP2) = U_MCP2 + +c Winkel: +c ------- + + do 200 alfaTgt = par(1,alfTgt),par(2,alfTgt),par(3,alfTgt) ! ALPHA(TARGET) + parWert(alfTgt) = alfaTgt + Sin_alfaTgt= sind(alfaTgt) + Cos_alfaTgt= cosd(alfaTgt) + + do 200 alfaSp = par(1,alfSp),par(2,alfSp),par(3,alfSp) ! ALPHA(SPIEGEL) + parWert(alfSp) = alfaSp + Sin_alfaSp = sind(alfaSp) + Cos_alfaSp = cosd(alfaSp) + Tan_alfaSp = tand(alfaSp) + help1 = dSpiegel/2.+DreharmLaenge + ! Berechne die y-Werte der 'oberen linken' (yUppLeft) und der + ! 'unteren linken' (yLowLeft) Spiegelecke: + if (idealMirror) then + yUppLeft = + bSpiegel/2. * Sin_alfaSp + + + help1 * Cos_alfaSp + yLowLeft = - bSpiegel/2. * Sin_alfaSp + + + help1 * Cos_alfaSp + endif + ! Berechne Schnittpunkt y_intersectSp der vorderen Spiegelebene bzw. + ! der vorderen Mappenkante mit der Geraden x = xSpiegel: + if (.NOT.idealMirror) help1 = help1 + xSpGrid1 + y_intersectSp = help1/Cos_alfaSp + + do 200 alfaTD = par(1,alfTD),par(2,alfTD),par(3,alfTD) ! ALPHA(TRIGGERDETEKTOR) + parWert(alfTD) = alfaTD + Sin_alfaTD = sind(alfaTD) + Cos_alfaTD = cosd(alfaTD) + Tan_alfaTD = tand(alfaTD) + ! Berechne Schnittpunkt 'x_intersectTD' der x-Achse mit der Folien- + ! ebene bzw im Fall von 'GridInFrontOfFoil' mit dem Gitter vor der + ! Triggerfolie: + help1 = d_Folie_Achse + if (gridInFrontOfFoil) help1 = help1 + d_Grid_Folie + x_intersectTD = xTD - help1/Cos_alfaTD + help1 = d_Folie_Achse + mappenLaenge_Fo + x_intersectTDMap = xTD - help1/Cos_alfaTD + +c TriggerDetektor: +c ---------------- + + do 200 U_V = par(1,UVorne),par(2,UVorne),par(3,UVorne) ! U(VORNE) + parWert(UVorne) = U_V + do 200 U_H = par(1,UHinten),par(2,UHinten),par(3,UHinten) ! U(HINTEN) + parWert(UHinten) = U_H + do 200 U_MCP3 = par(1,UMCP3),par(2,UMCP3),par(3,UMCP3) ! U(MCP3) + parWert(UMCP3) = U_MCP3 + do 200 U_F = par(1,UFolie),par(2,UFolie),par(3,UFolie) ! U(FOLIE) + parWert(UFolie) = U_F + +c Transportsystem: +c ---------------- + + do 200 U_L2 = par(1,UL2),par(2,UL2),par(3,UL2) ! U(Linse 2) + parWert(UL2) = U_L2 + +c gegebenenfalls die Mappe 'L2andFo' zusammenbauen: + if (lense2) then + if ( .NOT.(par(1,UL2).EQ.0. .AND. n_par(UL2).LE.1) .OR. + + .NOT.(par(1,UFolie).EQ.0. .AND. n_par(UFolie).LE.1) ) then + ! Addiere die Mappen nur erneut, falls die jetztige Konfiguration + ! nicht mit der letzten uebereinstimmt: + if (U_L2.NE.last_U_L2 .OR. U_F.NE.last_U_F) then + call ADD_MAP_L2andFo + last_U_L2 = U_L2 + last_U_F = U_F + endif + endif + endif + + do 200 U_Sp = par(1,USp),par(2,USp),par(3,USp) ! U(SPIEGEL) + parWert(USp) = U_Sp + + do 200 U_L1 = par(1,UL1),par(2,UL1),par(3,UL1) ! U(Linse 1) + parWert(UL1) = U_L1 + + do 200 U_L3 = par(1,UL3),par(2,UL3),par(3,UL3) ! U(Linse 3) + parWert(UL3) = U_L3 + +c die Magnetfelder: +c ----------------- + + do 200 B_Helm = par(1,BHelm),par(2,BHelm),par(3,BHelm) ! Helmholtzsp. + parWert(BHelm) = B_Helm + + do 200 B_TD = par(1,BTD),par(2,BTD),par(3,BTD) ! TD-Spule + parWert(BTD) = B_TD + +c Masse und Ladung: +c ----------------- + + do 200 m_ = par(1,mass),par(2,mass),par(3,mass) ! MASSE + if (.NOT.artList_defined) then + m = m_ + parWert(mass) = m + endif + + do 200 q_ = par(1,charge),par(2,charge),par(3,charge) ! LADUNG + if (.NOT.artList_defined) then + q = q_ + parWert(charge) = q + else + qIndxMu = q_ ! fuer Verwendung in function firstEventNr! + ArtNr = Art_Nr(q_) + m = Art_Masse(ArtNr) + q = Art_Ladung(ArtNr) + parWert(mass) = m + parWert(charge) = q + endif + ! gegebenenfalls ein Flag fuer die Beruecksichtigung des Myonen- + ! zerfalles setzen: + if (useDecay) then ! 'useDecay' setzt 'artList_defined' voraus + if (ArtNr.LE.4) then! es ist ein Myon involviert + useDecay_ = .true. + else ! kein Myon involviert + useDecay_ = .false. + endif + endif + + +c Beschleuniger: +c -------------- + + do 200 U_Tgt = par(1,UTgt),par(2,UTgt),par(3,UTgt) ! U(TARGET) + parWert(UTgt) = U_Tgt + do 200 U_Gua = par(1,UGua),par(2,UGua),par(3,UGua) ! U(GUARD) + parWert(UGua) = U_Gua + do 200 U_G1 = par(1,UG1),par(2,UG1),par(3,UG1) ! U(GITTER) + parWert(UG1) = U_G1 + parIndx(5) = parIndx(5) + 1 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c haeufig benoetigte Faktoren, die von der aktuellen Masse, Ladung und Hoch- +c spannungen abhaengen: +c (bei Linse 2 wird die Spannung direkt auf die Potentialmappe aufmultipliziert. +c Daher wird dort 'Beschl_Faktor' verwendet und kein 'Beschl_Faktor_L2' benoetigt) + + Energie_Faktor = m / (2.*c*c) + Beschl_Faktor = q / m * c*c + Beschl_Faktor_L1 = Beschl_Faktor * U_L1 + Beschl_Faktor_Sp = Beschl_Faktor * U_Sp + Beschl_Faktor_FO = Beschl_Faktor * U_F + Beschl_Faktor_L3 = Beschl_Faktor * U_L3 + Beschl_Faktor_M2 = Beschl_Faktor * U_MCP2 + + aFoil = - Beschl_Faktor * U_F / d_Grid_Folie + if (U_Sp.EQ.0. .OR. q.EQ.0.) then + Spiegel_Faktor = 0 + else + Spiegel_Faktor = 2.*dspiegel / (Beschl_Faktor * U_Sp) !<-- pruefen! + endif + + ! Die Beschleunigungen in den beiden (idealen) Beschleunigerstufen: + a1 = Beschl_Faktor * (U_Tgt - U_G1) / (XGrid1 - XTarget) + a2 = Beschl_Faktor * U_G1 / (XGrid2 - xGrid1) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Falls 'fromScratch': +c Die in den ab hier beginnenden Startparameter-Schleifen gesetzten Werte +c werden gegebenenfalls weiter unten durch zufallsverteilte Offsets modi- +c fiziert. (-> 'Zufallschleife': 'do 100 randomloop_ = 1, n_par(0)) +c Andernfalls: +c Wurden waehrend ACCEL oder 'foilfile' fuer die Startparameter Zufalls- +c verteilungen verwendet, so werden die entsprechenden Groessen aus dem +c betreffenden NTupel eingelesen. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Startparameter: +c --------------- + + do 200 E0_ = par(1,ener),par(2,ener),par(3,ener) ! E0 + if (.NOT.random_E0) then + E0 = E0_ + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (E0InterFromFile) then + lowerE0 = E0Low(nInt(E0_)) + upperE0 = E0Low(nint(E0_+1)) + endif + + +c falls Energieverlustberechnung aus ICRU-Tabelle verlangt ist und mittlerer +c Energieverlust nicht fuer jedes Teilchen extra berechnet werden soll (sinnvoll +c wenn alle Teilchen gleiche Startenergie haben oder Streuung der Startenergien +c klein ist, so dass die Streuung des mittleren Energieverlustes vernachlaessigt +c werden kann): + + if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,mean_E_Verlust) + endif + + if (log_Meyer_F_Function) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + effRedThick = Meyer_Faktor1 * Thickness + call Get_F_Function_Meyer(effRedThick,Ekin) + endif + + do 200 theta0_ = par(1,thetAng),par(2,thetAng),par(3,thetAng) ! theta0 + if (.NOT.random_angle) then + theta0 = theta0_ + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + do 200 phi0_ = par(1,phiAng),par(2,phiAng),par(3,phiAng) ! phi0 + if (.NOT.random_angle) then + phi0 = phi0_ + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + do 200 y0_ = par(1,yPos),par(2,yPos),par(3,yPos) ! y0 + if (.NOT.random_pos) then + x0(2) = y0_ + endif + + do 200 z0_ = par(1,zPos),par(2,zPos),par(3,zPos) ! z0 + if (.NOT.random_pos) then + x0(3) = z0_ + endif + +c die folgenden parWert(n) werden u.U. in der 'Zufallsschleife' weiter unten +c abgeaendert. Hier werden sie in jedem Fall fuer Tabellenausgaben, Debug- +c angelegenheiten u.s.w. erst einmal mit den aktuellen Werten der +c entsprechenden Schleifen gefuellt: + + parWert(ener) = E0_ + parWert(thetAng) = theta0_ + parWert(phiAng) = phi0_ + parWert(yPos) = y0_ + parWert(zPos) = z0_ + + +c falls fruehere Simulation fortgefuehrt wird: +c Berechne diejenige Eventnummer in NTP_read, ab welcher die relevanten +c Simulationsparameter von ACCEL bzw. des 'FoilFiles' mit den gegenwaertigen +c MUTRACK-(Schleifen)-Parametern uebereinstimmen: + + if (.NOT.fromScratch) eventNr = firstEventNr() + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die Befehle, die zu Beginn jeder neuen Schleife faellig sind: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + SchleifenNr = SchleifenNr + 1 ! Schleifen zaehlen + okStepsCounter = 0 ! 'okStepsCounter' dient der Bestimmung + ! der mittleren Anzahl von Integrations- + ! schritten bis zum Ziel + nNeutral = 0 ! noch wurden keine Teilchen in der TD-Folie + nCharged = 0 ! neutralisiert + +c Die Statistikspeicher resetten: +c Falls nur ein Teilchenstart pro Schleife erfolgt, nimm die Statistik ueber +c alle Schleifen. (Dann erfolgt der Reset nur bei der ersten Schleife): + + flag_ok = (.NOT.(OneStartPerLoop .AND. SchleifenNr.GT.1)) + + if (flag_ok) call reset_statistics + + +c Die Kammer zeichnen: +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Zeichne die Kammer dann also nur bei der ersten Schleife. + + if (GRAPHICS .AND. flag_ok) then + CALL IZPICT ('CHAM_1','M') ! ERZEUGEN VON BILDERN IM PAWC-COMM-BLOCK + CALL IZPICT ('CHAM_2','M') + CALL IZPICT ('HISTO','M') + CALL IZPICT ('TEXT','M') + call plot_chamber(schnitt_p) + call Graphics_Text ! Text fuer Textwindow erstellen + call text_plot ! Ausgabe des Textes + endif + + +c Ausgabe der aktuellen Settings: +c Auch dies im Falle von 'OneStartPerLoop' nur bei der ersten Schleife: + + if ((n_outWhere.NE.0 .OR. smallLogFile) .AND. flag_ok) then + call output_new_loop(q_) ! (q_) wegen der neutral fractions + endif + + +c Ausgabe der Prozentzahl schon gerechneten Trajektorien vorbereiten: + + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,1001)Uhrzeit,' %: 0' + endif +1001 format ($,6x,A,A) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c bei 'fromScratch': +c Hier wird gegebenenfalls bei Zufallsverteilung von Startparametern ein ent- +c sprechend gewuerfelter Offset auf den aktuellen Wert aufgeschlagen. +c Ansonsten: +c Lies bei Zufallsverteilungen die entsprechenden Startwerte aus dem NTupel +c ein. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + do 100 randomloop_ = 1, n_par(0) + + if (.NOT.fromScratch) then + + eventNr = eventNr + 1 ! Eventnummer im NTP + + if (smearS1Fo.AND.use_MUTRACK) call HGNTB(NTP_read,'S1FoS',eventNr,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)' error executing ''call HGNTB(',NTP_read,',''S1FoS'',eventNr,istat)''' + write(*,*)' eventNr = ',eventNr + write(*,*)' -> STOP' + write(*,*) + call exit + endif + + ! Einlesen von 'Gebiet' und 'destiny': + call HGNTB(NTP_read,'dest',eventNr,istat) + ! gegebenenfallsvon freuher verwendete Gebietskodierung + ! (ohne Linse2) aktualisieren + if (gebiet.GE.10 .AND. MutrackVersionIndx.LE.1) gebiet = gebiet+2 + +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''dest'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + ! Einlesen der Trajektoriendaten 't,x(3),v(3)': + call HGNTB(NTP_read,'Traj',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''Traj'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + + if (Use_Accel) then + ! Uebersetzen der von ACCEL verwendeten code_Nummern fuer die + ! moeglichen Teilchenschicksale in von MUTRACK verwendete + ! code_Nummern: + if (destiny.EQ.-5) then + destiny = code_frontOfMapAc + elseif (destiny.EQ.-4) then + destiny = code_leftMapAc + elseif (destiny.EQ.-3) then + gebiet = upToGrid2 + destiny = code_grid + elseif (destiny.EQ.-2) then + gebiet = upToGrid1 + destiny = code_grid + elseif (destiny.EQ.-1) then + destiny = code_hit_TgtHolder + elseif (destiny.EQ.code_ok) then + Gebiet = upToHeShield + elseif (destiny.EQ.+1) then + destiny = code_decay + elseif (destiny.EQ.+2) then + destiny = code_reflektiert + elseif (destiny.EQ.+3) then + destiny = code_wand + elseif (destiny.EQ.+4) then + destiny = code_lost + elseif (destiny.EQ.+5) then + destiny = code_dtsmall + else + write(*,*)'UNKNOWN ACCEL-CODE-NR: destiny = ',destiny + call exit + endif + + ! Auf xGrid2 zurueckrechnen, damit unabhaengiger Test auf + ! Treffer des He-Fensters gemacht werden kann (nur, falls + ! Teilchen nicht schon anderweitig gestorben ist). Auch + ! notwendig fuer Graphikausgabe. + + if (destiny.EQ.0) then + dt = (xGrid2-x(1))/v(1) ! < 0. + t = t + dt + x(1) = xGrid2 + x(2) = x(2)+v(2)*dt + x(3) = x(3)+v(3)*dt + endif + + ! falls Kryo verdreht ist, rechne in Kammerkoordinaten um: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + help1 = x(1) + x(1) = help1 * Cos_alfaTgt - x(3) * Sin_alfaTgt + x(3) = help1 * Sin_alfaTgt + x(3) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(3) * Sin_alfaTgt + v(3) = help1 * Sin_alfaTgt + v(3) * Cos_alfaTgt + else + help1 = x(1) + x(1) = help1 * Cos_alfaTgt - x(2) * Sin_alfaTgt + x(2) = help1 * Sin_alfaTgt + x(2) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(2) * Sin_alfaTgt + v(2) = help1 * Sin_alfaTgt + v(2) * Cos_alfaTgt + endif + endif + + endif + + endif + + if (random_E0) then ! random_ENERGIE + if (fromScratch) then + if (random_E0_equal) then ! -> gleichverteilt +300 E0 = E0_ + lowerE0 + (upperE0 - lowerE0)*ran(seed) + if (E0.LT.0) goto 300 + elseif (random_E0_gauss) then ! -> gaussverteilt +310 call Gauss_Verteilung(sigmaE0,help1) + E0 = E0_ + help1 + if (E0.LT.0) goto 310 + endif + else + ! Einlesen von 'E0' aus NTP: + call HGNTB(NTP_read,'E0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(NTP_read,''E0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + parWert(ener) = E0 + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (random_pos) then ! random_POSITION + if (fromScratch) then + if (random_y0z0_equal) then ! -> rechteckig, gleichverteilt + x0(2) = StartBreite * (ran(seed)-.5) + x0(3) = StartHoehe * (ran(seed)-.5) + elseif (random_y0z0_Gauss) then ! -> rechteckig, Gaussverteilt +320 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + if (abs(x0(2)).GT.StartBreite/2.) goto 320 + x0(3) = r0 * sind(phi_r0) + if (abs(x0(3)).GT.StartHoehe/2.) goto 320 + elseif (random_r0_equal) then ! -> rund, gleichverteilt + r0 = StartRadius * sqrt(ran(seed)) + phi_r0= 360. * ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + elseif (random_r0_Gauss) then ! -> rund, Gaussverteilt +330 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + if (r0.GT.StartRadius) goto 330 + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + endif + x0(2) = y0_ + x0(2) + x0(3) = z0_ + x0(3) + else + ! Einlesen von 'x0(3)' aus NTP: + call HGNTB(NTP_read,'x0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''x0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + parWert(yPos) = x0(2) + parWert(zPos) = x0(3) + endif + + if (random_angle) then ! random_WINKEL + if (fromScratch) then +340 if (random_lambert) then ! -> Lambert-verteilt + call lambert_verteilung(StartLambertOrd, + + Cos_theta0,Sin_theta0) + theta0 = acosd(Cos_theta0) + elseif (random_gauss) then + call Gauss_Verteilung_theta(sigmaWinkel,theta0) + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + + phi0 = 360.*ran(seed) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + + if (angle_offset) then + +c -> Es soll aus gewuerfelter Startrichtung (theta0,phi0) und durch die Winkel- +c schleifen vorgegebenen Startrichtung (theta0_,phi0_) die tatsaechliche +c Startrichtung berechnet werden. Dafuer werden die gewuerfelten Winkel als +c 'Streuwinkel' betrachtet. +c Vorgehensweise: +c Es werden die Komponenten eines Geschwindigkeitsvektors mit Betrag=1 und durch +c theta0_,phi0_ bestimmter Richtung berechnet. Danach werden die Komponenten des +c mit theta0,phi0 gestreuten Geschwindigkeitsvektors und die zugehoerigen Winkel +c gewonnen, die dann als neuetheta0,phi0 als die tatsaechlichen Startwinkel +c verwendet werden. Das alles geschieht vollkommen analog zur Winkelaufstreuung +c in der Triggerfolie. +c v wird als Hilfsvariable missbraucht. + + ! Berechnung der 'Geschwindigkeitskomponenten': + v(1) = cosd(theta0_) + help1 = sind(theta0_) + v(2) = help1 * cosd(phi0_) + v(3) = help1 * sind(phi0_) + ! v_xy ist stets groesser 0 ausser wenn die Zentralrichtung + ! senkrecht nach oben oder unten gerichtet ist. Diese Wahl ist + ! aber sowieso wenig sinnvoll: + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) + if (v_xy.EQ.0.) then + write(*,*) + write(*,*)' Bei Zufallsverteilung fuer Startwinkel darf die durch die Winkelschleifen' + write(*,*)' vorgegebene Zentralrichtung nicht senkrecht nach oben oder nach unten weisen!' + write(*,*)' -> STOP' + STOP + endif + ! berechne neue 'Geschwindigkeitskomponenten': + help1 = v(1) + help2 = v(2) + help3 = Sin_theta0*Cos_phi0/v_xy + help4 = Sin_theta0*Sin_phi0 + v(1) = Cos_theta0*help1 - help3*help2 - help4*help1*v(3)/v_xy + if (v(1).LT.0.) goto 340 + v(2) = Cos_theta0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = Cos_theta0*v(3) + help4*v_xy + ! Berechne tatsaechlichen Startwinkel: + if (v(2).EQ.0. .AND. v(3).EQ.0.) then + if (v(1).GE.0) then + theta0 = 0. + else + theta0 = 180. + endif + phi0 = 0. + else + theta0 = acosd(v(1)) + phi0 = atan2d(v(3),v(2)) + if (phi0.LT.0) phi0 = phi0+360. + endif + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + if (theta0.GT.90.) goto 340 + + else + + ! Einlesen von 'theta0' und 'phi0' aus NTP: + call HGNTB(NTP_read,'angle0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''angle0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + + endif + + parWert(thetAng) = theta0 + parWert(phiAng) = phi0 + + endif + + ! Berechnung der Start-Geschwindigkeitskomponenten: + v0(1) = v0_Betrag * Cos_theta0 + v0(2) = v0_Betrag * Sin_theta0 * Cos_phi0 + v0(3) = v0_Betrag * Sin_theta0 * Sin_phi0 + + if (fromScratch) then + ! den Zeit-Speicher resetten: + t = 0. + ! Startparameter in Koordinatenspeicher uebergeben: + do i = 1, 3 + x(i) = x0(i) + v(i) = v0(i) + enddo + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die restl. Vorbereitungen zum Start des individuellen Projektils: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c n_dtsmall resetten: + + n_dtsmall = 0 + + +c Aufstreuwinkel resetten: + + thetaAufstreu = 0. + phiAufstreu = 0. + + +c x-Komponente der Startgeschwindigkeit ueberpruefen: + + if (v0(1).LT.0) then + write(*,*) + write(*,*) ' >>>> v(x) beim Start negativ!' + write(*,*) + call exit + endif + + +c die Lebensdauer wuerfeln: +c (wird eine fruehere Simulation fortgefuehrt und wurde dort bereits der Myonen- +c zerfall beruecksichtigt, so verwende die dort gewuerfelten Lebenszeiten) + + if (UseDecay_) then + if (.NOT.UseDecay_prevSim) then +350 lifeTime = -meanlifeTime * Log(Ran(seed) + 1.0E-37) + if (lifeTime.LE.0.) goto 350 + elseif (.NOT.fromScratch) then + call HGNTB(NTP_read,'lifetime',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''lifetime'',eventNr,istat)''' +c write(*,*)' eventNr = ', eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + endif + + +c die Ladung resetten (falls in der Folie Neutralisierung stattgefunden hat): +c ('qInt' wird fuer 'NTP_charge' benoetigt) + + q = parWert(charge) + qInt = int(q) + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien: + + if (log_percent) then + if (100.*real(start_nr(1))/real(n_par(0)) + + .GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,1002) percent_done + endif + endif +1002 format ($,'+',I3) + + +c andere Variablen auf den richtigen Stand bringen: + + if (fromScratch) then + destiny = code_ok ! bis jetzt ist dem Teilchen noch nichts zugestossen + Gebiet = Gebiet0 + endif + + start_nr(1) = start_nr(1) + 1 ! Projektil-Startnummer erhoehen + steps = 0 ! es wurden noch keine Integrationsschritte durchgefuehrt + NTPalreadyWritten = .false. ! fuer 'createFoilFile' + + +c die DEBUG-Daten ausgeben: + + if (Debug .AND. start_Nr(1).LE.DEBUG_Anzahl) then + Debug_ = .true. + call output_new_particle + call Output_Debug + else + Debug_ = .false. + endif + + +c StartKoordinaten fuer Graphikausgabe sichern: + + if (graphics .AND. (start_Nr(1).LE.graphics_Anzahl .OR. OneStartPerLoop)) then + graphics_ = .true. + if (Use_ACCEL) then + nKoord = 1 + xKoord(1) = x0(1) + yKoord(1) = x0(2) + zKoord(1) = x0(3) + else + nKoord = 0 + endif + if (.NOT.(Use_MUTRACK.OR.Gebiet0.EQ.upToExTD)) call Save_Graphics_Koord + else + graphics_ = .false. + endif + + +c gegebenenfalls 'fill_NTP' resetten: + + if (Fo_triggered.OR.M2_triggered.OR.xM2_triggered) fill_NTP = .false. + + +c Falls Schrittweiteninformationen im NTupel verlangt sind: Speicher resetten +c und Startkoordinaten sichern: + +d if (NTP_steps) then +d dtmin_L1 = +1.e10 +d x_dtmin_L1(1) = 0 +d x_dtmin_L1(2) = 0 +d x_dtmin_L1(3) = 0 +d dtmax_L1 = -1.e10 +d x_dtmax_L1(1) = 0 +d x_dtmax_L1(2) = 0 +d x_dtmax_L1(3) = 0 +d +d dtmin_L2andFo = +1.e10 +d x_dtmin_L2andFo(1) = 0 +d x_dtmin_L2andFo(2) = 0 +d x_dtmin_L2andFo(3) = 0 +d dtmax_L2andFo = -1.e10 +d x_dtmax_L2andFo(1) = 0 +d x_dtmax_L2andFo(2) = 0 +d x_dtmax_L2andFo(3) = 0 +d +d dtmin_FO = +1.e10 +d x_dtmin_FO(1) = 0 +d x_dtmin_FO(2) = 0 +d x_dtmin_FO(3) = 0 +d dtmax_FO = -1.e10 +d x_dtmax_FO(1) = 0 +d x_dtmax_FO(2) = 0 +d x_dtmax_FO(3) = 0 +d +d dtmin_L3 = +1.e10 +d x_dtmin_L3(1) = 0 +d x_dtmin_L3(2) = 0 +d x_dtmin_L3(3) = 0 +d dtmax_L3 = -1.e10 +d x_dtmax_L3(1) = 0 +d x_dtmax_L3(2) = 0 +d x_dtmax_L3(3) = 0 +d +d dtmin_M2 = +1.e10 +d x_dtmin_M2(1) = 0 +d x_dtmin_M2(2) = 0 +d x_dtmin_M2(3) = 0 +d dtmax_M2 = -1.e10 +d x_dtmax_M2(1) = 0 +d x_dtmax_M2(2) = 0 +d x_dtmax_M2(3) = 0 +d endif + + if (NTP_40mm) then + x40(2) = 0. + x40(3) = 0. + v40(1) = 0. + v40(2) = 0. + v40(3) = 0. + t40 = 0. + E40 = 0. + endif + + +c Die Flugzeiten resetten: + + S1xM2 = 0. + S1M2 = 0. + S1Fo = 0. + FoM2 = 0. + S1M3 = 0. + M3M2 = 0. + + +c Falls das Teilchen schon nicht mehr existiert, gehe gleich zur Ausgabe: + + if (destiny.NE.code_ok) goto 555 ! (nur bei '.NOT.fromScratch' moeglich) + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c hier starten die Projektile: +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + goto startLabel ! StartLabel = Gebiet0 als label + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c erste Beschleunigerstufe: (homogenes Feld) + +1 Gebiet = upToGrid1 + steps = Steps + 1 + + if (a1.NE.0.) then + help1 = v(1)*v(1) + 2.*a1*(xGrid1-x(1)) + if (help1.LT.0) then ! Reflektion noch vor 1. Gitter + dt = -2*v(1)/a1 + t = t + dt + !x(1) bleibt unveraendert + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/a1 + ! (ergibt sich aus x=v*t+1/2*a*t**2 mit richtiger V.Z.-Wahl ('+')) + v(1) = v(1) + a1*dt + else + if (v(1).EQ.0) then + write(*,*) + write(*,*)'ERROR: v(x) beim Start = 0. und '// + + 'Beschleunigung = 0' + write(*,*) + STOP + endif + dt = (xGrid1-xTarget) / v(1) + endif + + t = t + dt + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + x(1) = xGrid1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + +c - Aufgeschlagen? + + if (Abs(x(2)).gt.dygrid1/2. .OR. + + Abs(x(3)).gt.dzgrid1/2.) then + flag = .true. + destiny = code_wand + else + flag = .false. + endif + +c - Gitterstab getroffen? + + if (testOnWireHit) then + DrahtNr = nInt(x(2)/dist_Wires_G1) + distToWire(1) = 0. + distToWire(2) = x(2) - DrahtNr * dist_Wires_G1 + call Test_WireHit(distToWire,WireRadiusQuad_G1,v(1),v(2),WireHit) + if (WireHit) then + flag = .true. + destiny = code_grid + endif + endif + +c - Koordinatentransformation in Kammersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + help1 = x(3) + help2 = v(1) + help3 = v(3) + x(1) = xgrid1 * Cos_alfaTgt - help1 * Sin_alfaTgt + x(3) = xgrid1 * Sin_alfaTgt + help1 * Cos_alfaTgt + v(1) = help2 * Cos_alfaTgt - help3 * Sin_alfaTgt + v(3) = help2 * Sin_alfaTgt + help3 * Cos_alfaTgt + else + help1 = x(2) + help2 = v(1) + help3 = v(2) + x(1) = xgrid1 * Cos_alfaTgt - help1 * Sin_alfaTgt + x(2) = xgrid1 * Sin_alfaTgt + help1 * Cos_alfaTgt + v(1) = help2 * Cos_alfaTgt - help3 * Sin_alfaTgt + v(2) = help2 * Sin_alfaTgt + help3 * Cos_alfaTgt + endif + endif + +c - zerfallen? + + if (useDecay_) call Decay_Test(*555) + +c - falls aufgeschlagen: + + if (flag) goto 555 + +c - Koordinatentransformation zurueck in Beschleunigersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + x(1) = xGrid1 + x(3) = help1 + v(1) = help2 + v(3) = help3 + else + x(1) = xGrid1 + x(2) = help1 + v(1) = help2 + v(2) = help3 + endif + endif + +c - Datenausgabe: + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zweite Beschleunigerstufe: (homogenes Feld) + +2 Gebiet = upToGrid2 + steps = Steps + 1 + + if (a2.NE.0.) then + help1 = v(1)*v(1) + 2.*a2*(XGrid2-XGrid1) + if (help1.LT.0) then ! Reflektion noch vor 2. Gitter + dt = -2*v(1)/a2 + t = t + dt + !x(1) bleibt unveraendert + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/a2 + v(1) = v(1) + a2*dt + else + if (v(1).EQ.0) then ! (kann nur bei Start in 2. Stufe passieren) + write(*,*) + write(*,*)'ERROR: v(x) beim Start = 0. und '// + + 'Beschleunigung = 0' + write(*,*) + STOP + endif + dt = (XGrid2-XGrid1) / v(1) + endif + + t = t + dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + +c - Aufgeschlagen? + + if (Abs(x(2)).gt.dygrid2/2. .OR. + + Abs(x(3)).gt.dzgrid2/2.) then + flag = .true. + destiny = code_wand + else + flag = .false. ! <- noetig, falls Start auf 1. Gitter + endif + +c - Gitterstab getroffen? + + if (testOnWireHit) then + DrahtNr = nInt(x(2)/dist_Wires_G2) + distToWire(1) = 0 + distToWire(2) = x(2) - DrahtNr * dist_Wires_G2 + call Test_WireHit(distToWire,WireRadiusQuad_G2,v(1),v(2),WireHit) + if (WireHit) then + flag = .true. + destiny = code_grid + endif + endif + +c - Koordinatentransformation in Kammersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + x(1) = xgrid2 * Cos_alfaTgt - x(3) * Sin_alfaTgt + x(3) = xgrid2 * Sin_alfaTgt + x(3) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(3) * Sin_alfaTgt + v(3) = help1 * Sin_alfaTgt + v(3) * Cos_alfaTgt + else + x(1) = xgrid2 * Cos_alfaTgt - x(2) * Sin_alfaTgt + x(2) = xgrid2 * Sin_alfaTgt + x(2) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(2) * Sin_alfaTgt + v(2) = help1 * Sin_alfaTgt + v(2) * Cos_alfaTgt + endif + else + x(1) = xgrid2 + endif + +c - zerfallen? + + if (useDecay_) call Decay_Test(*555) + +c - falls aufgeschlagen: + + if (flag) goto 555 + +c - Datenausgabe: + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen zweitem Gitter und He-Shield: (feldfrei) + +3 Gebiet = upToHeShield + Steps = Steps + 1 + + radiusQuad = x(1)*x(1) + x(2)*x(2) + help1 = v(1)*v(1)+v(2)*v(2) + help2 = x(1)*v(1)+x(2)*v(2) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_HeShield))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen das Schild + x(3) = x(3) + dt*v(3) ! durchquert + + if (useDecay_) call Decay_Test(*555) + if (Abs(x(2)).gt.DYHESHIELD/2. .OR. + + Abs(x(3)).gt.DZHESHIELD/2.) then + destiny = code_wand + goto 555 + endif + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c Groessen bei x=40 mm berechnen: + + if (NTP_40mm) then + dt = (40-x(1))/v(1) + x40(2) = x(2)+v(2)*dt + x40(3) = x(3)+v(3)*dt + v40(1) = v(1) + v40(2) = v(2) + v40(3) = v(3) + t40 = t + dt + ! help1 = v(1)*v(1)+v(2)*v(2) noch bekannt von 'upToHeShield' + v_square = help1 + v(3)*v(3) + E40 = v_square * Energie_Faktor + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen He-Shield und LN-Shield: (feldfrei) + +4 Gebiet = upToLNShield + Steps = Steps + 1 + + radiusQuad = x(1)*x(1) + x(2)*x(2) + ! help1 = v(1)*v(1)+v(2)*v(2) ! noch bekannt von 'upToHeShield' + help2 = x(1)*v(1)+x(2)*v(2) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_LNShield))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen das Schild + x(3) = x(3) + dt*v(3) ! durchquert + + if (useDecay_) call Decay_Test(*555) + if (abs(x(2)).gt.dyLNShield/2. .OR. + + Abs(x(3)).gt.dzLNShield/2.) then + destiny = code_wand + goto 555 + endif + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen LN-Shield und Beginn der L1-Mappe: (feldfrei) + +5 Gebiet = upToL1Map + Steps = Steps + 1 + + dt = (xEnterMap_L1 - x(1)) / v(1) + + t = t + dt + x(1) = xEnterMap_L1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + if (radiusQuad.GT.radiusQuad_L1) then ! Teilchen fliegt an L1 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb L1: (inhom. Felder -> Integrationen) + +6 Gebiet = upToExL1 ! GebietsNummer fuer L1 setzen + +c Teste, ob das Teilchen ueberhaupt eine Beschleunigung erfaehrt (Spannung=0?, +c Ladung=0?). Falls nicht, steppe gleich bis zum Mappenende: + + if (Beschl_Faktor_L1.EQ.0) then +d dtmax_L1 = 0. +d dtmin_L1 = 0. + dt = (xLeaveMap_L1 - x(1)) / v(1) ! Zeit bis zum Mappenende + x(1) = xLeaveMap_L1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + goto 5106 + endif + +c............................................................................... +c Das Teilchen spuert eine Beschleunigung, es muss also integriert werden. +c Gehe als ersten Versuch 0.5 mm in das Gebiet hinein: + + dt = .5/v(1) + zaehler = 0 + +c............................................................................... +c hierher wird zurueckgesprungen, solange die Integration in der L1 bleibt + +5006 call INTEGRATIONSSTEP_RUNGE_KUTTA_L1(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_L1) then +d dtmin_L1 = dt +d x_dtmin_L1(1) = x(1) +d x_dtmin_L1(2) = x(2) +d x_dtmin_L1(3) = x(3) +d endif +d if (dt.GT.dtmax_L1) then +d dtmax_L1 = dt +d x_dtmax_L1(1) = x(1) +d x_dtmax_L1(2) = x(2) +d x_dtmax_L1(3) = x(3) +d endif +d endif + +c............................................................................... +5106 Steps = Steps + 1 ! neuer Ort, Zeit und Geschwindigkeit sind festgelegt + +c do some tests: + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_L1))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L1-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (x(1).LT.xEnterMap_L1) then + if (v(1).LT.0) then ! reflektiert? + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L1: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + STOP + endif + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + elseif (x(1).GE.xLeaveMap_L1) then ! Verlasse L1 + dt = (xLeaveMap_L1 - x(1))/v(1) ! rechne zurueck auf exaktes + t = t + dt ! Mappenende + x(1) = xLeaveMap_L1 + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + goto bis_Spiegel ! -> Mache bei upToEnSp weiter +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L1-2: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + endif + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5006 ! naechster Integrationsschritt in L1-Mappe + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen Linse 1 und Spiegel: (feldfrei) + +7 Gebiet = upToEnSp + Steps = Steps + 1 + +c - berechne Schnittpunkt mit forderer Spiegelebene: + + help2 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene + + if (help2.GE.Tan_alfaSp) then + ! Teilchen fliegt am Spiegel vorbei + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + if (useDecay_) call Decay_Test(*555) + destiny = code_vorbei + goto 555 + else + ! help1 == neues x(1) + help1 = (x(2) - y_intersectSP + xSpiegel*Tan_alfaSp + + - xLeaveMap_L1*help2) / (Tan_alfaSp - help2) + + dt = (help1-x(1)) / v(1) + t = t + dt + x(1) = help1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + endif + + if (useDecay_) call Decay_Test(*555) + if (Debug_) call Output_Debug + + +c Berechnung der Trajektorie bei idealem Spiegel: + + if (idealMirror) then ! ~~~ 40: if ~~~~~~~~~~~ + +c - pruefe, ob das Teilchen die ForderSEITE des Spiegels trifft: + + if ( x(2).GT.yUppLeft .OR. x(2).LT.yLowLeft .OR. + + abs(x(3)).GT.HSpiegel/2.) then + ! -> Teilchen fliegt am Spiegel vorbei + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_vorbei + goto 555 + endif + + +c - pruefe, ob das Teilchen einen Gitterstab des Spiegels trifft: + + if (testOnWireHit) then + help1 = x(2)-yLowLeft ! Abstand zum Bezugspunkt + DrahtNr = nInt(help1/(Sin_alfaSp*dist_Wires_Sp)) + distToWire(2) = help1 - DrahtNr * Sin_alfaSp*dist_Wires_Sp + distToWire(1) = distToWire(2)/Tan_alfaSp + call Test_WireHit(distToWire,WireRadiusQuad_Sp,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_grid + goto 555 + endif + endif + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c im Spiegel: (homogenes Feld) + +8 Gebiet = upToExSp + Steps = Steps + 1 + +c - pruefe, ob Teilchen nicht zuviel Energie senkrecht zum Spiegel hat: + + if (Spiegel_Faktor.EQ.0.) then ! Spannung=0. oder q=0 + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + ! help1 == Winkel in xy-Ebene zwischen Bewegungsrichtung und Spiegelfront + + help1 = alfaSp - atand(v(2)/v(1)) + + ! help2 = Geschw.Komponente senkrecht auf den Spiegel gerichtet + ! help3 = Geschw.Komponente parallel zum Spiegel, zu positiven y hin + + v_xy = sqrt( v(1)*v(1) + v(2)*v(2) ) + help2 = sind(help1) * v_xy + help3 = cosd(help1) * v_xy + + if (help2*help2*Energie_Faktor.GE.q*U_Sp) then + ! Teilchen tritt durch Spiegel durch + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + if (Graphics_) call Save_Graphics_Koord + + +c - berechne Zeit, bis Teilchen wieder auf Spiegelforderseite ist: + + dt = help2 * Spiegel_Faktor ! Spiegel_Faktor == 2 / a + t = t + dt + +c - berechne Versetzung in xy-Ebene, parallel zur Spiegelebene, +c in 'positiver y-Richtung' (speichere in 'help1'): + + help1 = help3*dt + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c falls Graphikausgabe verlangt ist: +c Um die Teilchenbahn im Innern des Spiegels anzudeuten, berechne die Orte bei +c t+dt/4, t+td/2 und t+3dt/4. Bestimme dafuer erst die jeweilige Versetzung +c senkrecht zur Spiegelebene aus dx = vx * t + 1/2 * a * t**2. +c (speichere in help4): + + if (Graphics_) then + + help4 = help2*dt*.25 - (dt*dt*.0625)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.25*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.25*Sin_alfaSp + zKoord(nKoord) = x(3) + v(3)*dt*.25 + + help4 = help2*dt*.50 - (dt*dt*.2500)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.50*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.50*Sin_alfaSp + zKoord(nKoord) = x(3)+v(3)*dt*.50 + + help4 = help2*dt*.75 - (dt*dt*.5625)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.75*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.75*Sin_alfaSp + zKoord(nKoord) = x(3)+v(3)*dt*.75 + + endif +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c - berechne Austrittsort: + + x(1) = x(1) + help1 * Cos_alfaSp + x(2) = x(2) + help1 * Sin_alfaSp + x(3) = x(3) + v(3)*dt + + +c - berechne Austrittsgeschwindigkeit (help2 geht bei Spiegelung in -help2 ueber): + + v(1) = help3 * Cos_alfaSp - help2 * Sin_alfaSp + v(2) = help2 * Cos_alfaSp + help3 * Sin_alfaSp + + if (v(2).LE.0) then + write(*,*) + write(*,*)'ERROR: nach Spiegel ist v(y) <= 0.' + write(*,*) + STOP + endif + + if (useDecay_) call Decay_Test(*555) + + +c - pruefe, ob Austrittspunkt auf forderer Spiegelflaeche liegt: + + if (x(2).GT.yUppLeft .OR. x(2).LT.yLowLeft .OR. + + abs(x(3)).GT.hSpiegel/2.) then + ! Teilchen trifft auf Spiegelwand + destiny = code_wand + goto 555 + endif + + +c - pruefe, ob das Teilchen einen Gitterstab des Spiegels trifft: + + if (testOnWireHit) then + help1 = x(2)-yLowLeft ! Abstand zum Bezugspunkt + DrahtNr = nInt(help1/(Sin_alfaSp*dist_Wires_Sp)) + distToWire(2) = help1 - DrahtNr * Sin_alfaSp*dist_Wires_Sp + distToWire(1) = distToWire(2)/Tan_alfaSp + call Test_WireHit(distToWire,WireRadiusQuad_Sp,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_grid + goto 555 + endif + endif + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + goto 9 + + endif ! ~~~ 40: endif ~~~~ + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der Spiegelmappe (dx = 0.050 mm, dy = 0.050 mm) + + Gebiet = upToExSp + nKoordSave = nKoord + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_Sp.EQ.0. .OR. q.EQ.0) then +d dtmax_Sp = 0. +d dtmin_Sp = 0. + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + dt = 0.5/v(1) + + reachedEndOfMap = .false. + zaehler = 0 + + +c Rechne in Spiegelmappen-Koordinaten um: +c Im Spiegelmappensystem: x-Achse verlaueft entlang der forderen Mappenkante, +c y-Achse aus dem Spiegel heraus. (entgegen der Richtung zunehmender Mappen- +c j-indizierung!) + + +5008 help1= x(1) - xSpiegel + x(1) = - x(2)*Cos_alfaSp + help1*Sin_alfaSp + + + (dSpiegel/2.+DreharmLaenge+xSpGrid1) + x(2) = x(2)*Sin_alfaSP + help1*Cos_alfaSP + help1= v(1) + v(1) = - v(2)*Cos_alfaSp + help1*Sin_alfaSp + v(2) = v(2)*Sin_alfaSP + help1*Cos_alfaSP + + +c mache Integrationsschritt: + + call INTEGRATIONSSTEP_RUNGE_KUTTA_Sp(dt) ! setzt u.U. auch 'destiny' + + Steps = Steps + 1 + + +c do some tests: + + if (Steps.GE.MaxStep) destiny = code_lost ! Teilchen verloren + + +c - Potentialmappe nach Reflektion wieder verlasssen? + + if (x(1).LT.0) then + reachedEndOfMap = .true. + +c - Spiegelrahmen getroffen? + + elseif (x(1).GE.xSpGrid1 .AND. + + (abs(x(2)).GT.bSpiegel/2. .OR. abs(x(3)).GT.hSpiegel/2.)) then + destiny = code_wand + +c - Gitterstab getroffen? + + else + help1 = min(abs(x(1)-xSpGrid1),abs(x(1)-xSpGrid1)) + if (help1.LE.rWires_Sp) then + DrahtNr = nInt(x(2)/dist_Wires_Sp) + distToWire(2) = x(2) - DrahtNr * dist_Wires_Sp + if ( (help1*help1 + distToWire(2)*distToWire(2)).LE. + + radiusQuad_Sp) destiny = code_grid + endif + + endif + +c if (destiny.NE.code_ok) then +c if (x(1).LT.xSpGrid1) then +c if (v(1).GT.0) then +c gebiet = UpToGrid +c else +c gebiet = upToExMap +c endif +c else +c gebiet = RetToGrid +c endif +c endif + + +c Rechne in Kammerkoordinaten zurueck: + + help1= x(1)-(dSpiegel/2.+DreharmLaenge+xSpGrid1) + x(1) = help1*Sin_alfaSP + x(2)*Cos_alfaSP + xSpiegel + x(2) = - help1*Cos_alfaSP + x(2)*Sin_alfaSP + help1= v(1) + v(1) = help1*Sin_alfaSP + v(2)*Cos_alfaSP + v(2) = - help1*Cos_alfaSP + v(2)*Sin_alfaSP + +d if (NTP_steps) then +d if (dt.LT.dtmin_Sp) then +d dtmin_Sp = dt +d x_dtmin_Sp(1) = x(1) +d x_dtmin_Sp(2) = x(2) +d x_dtmin_Sp(3) = x(3) +d endif +d if (dt.GT.dtmax_Sp) then +d dtmax_Sp = dt +d x_dtmax_Sp(1) = x(1) +d x_dtmax_Sp(2) = x(2) +d x_dtmax_Sp(3) = x(3) +d endif +d endif + + +c zerfallen? + + if (useDecay_) call Decay_Test(*555) + + +c Bahnberechnung abgebrochen? + + if (destiny.NE.code_ok) goto 555 + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (GRAPHICS_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + if (.NOT.reachedEndOfMap) goto 5008 ! naechster Integrationsschritt + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen Spiegel und Koordinatenwechsel-Ebene y=xChangeKoord: (feldfrei) + +9 Gebiet = upToChKoord + Steps = Steps + 1 + + if (x(2).LT.xChangeKoord) then + ! gegebenenfalls flag fuer Graphikausgabe des Punktes setzen + flag = .true. + else + flag = .false. + endif + + dt = (xChangeKoord - x(2)) / v(2) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = xChangeKoord + x(3) = x(3) + v(3)*dt + + help4 = x(1)-xSpiegel + radiusQuad = help4*help4 + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(1)*v(1)+v(3)*v(3) + help2 = help4*v(1)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_.AND.flag) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c falls Graphikausgabe verlangt ist: Gib jetzt die Trajektorie im 'horizontalen' +c Teil der Kammer aus und resette nKoord: + + if (Graphics_) then + + call plot_horizontal + if (schnitt_p.eq.1) call schnitt ! Schnittebene + + ! die letzten Koordinaten fuer Plot der Trajektorie im 2. Kammerteil + ! uebernehmen (in neues KoordinatenSystem transformiert): + + k = nKoord + + if (idealMirror) then + nKoord = 7 + else + if (nKoord.LT.nKoordSave) then + ! => ein 'turn over' fand statt waehrend das Teilchen in der + ! Spiegelmappe war => x(999) -> x(1), x(1000) -> x(2) + nKoord = nKoord + (999-nKoordSave) + else + nKoord = nKoord - nKoordSave + 1 + endif + nKoord = nKoord-2 + endif + + do i = nKoord, 1, -1 + xKoord_(i) = yKoord(k) + yKoord_(i) = xSpiegel - xKoord(k) + zKoord_(i) = zKoord(k) + k = k - 1 + if (k.EQ.0) then + k = 998 + endif + enddo + do i = 1, nKoord + xKoord(i) = xKoord_(i) + yKoord(i) = yKoord_(i) + zKoord(i) = zKoord_(i) + enddo + endif + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c - Vollziehe Koordinatenwechsel: neuer Ursprung in der Spiegelaufhaengung, +c x-Richtung in bisherige y-Richtung (also wiederum entlang Strahlachse), +c y-Richtung in bisheriger negativer x-Richtung. z-Richtung bleibt gleich. + + help1 = x(2) + x(2) = xSpiegel - x(1) + x(1) = help1 + help1 = v(1) + v(1) = v(2) + v(2) = - help1 + + if (Debug_) then + write (lun(1),*) 'KOORDINATENWECHSEL:' + call Output_Debug + endif + + +c Beruecksichtige gegebenenfalls die Flugzeit in 'delta_L1', welches 'vor dem +c Triggerdetektor' eingeschoben werden kann: + + dt = Delta_L1 / v(1) + x(1) = x(1)+v(1)*dt + x(2) = x(2)+v(2)*dt + x(3) = x(3)+v(3)*dt + t = t + dt + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + if (lense2) then ! ~~~~~~~~~~~~~~ ******* ~~~~~~~~~~~~~~~ + +c Bei 'lense2' wird fuer das Feld der Linse 2 und das Feld der TD-Folie eine +c gemeinsame Mappe verwendet. Hierbei ist allerdings der Triggerwinkel auf 0 +c Grad festgelegt. Da es in Zukunft in der Praxis wohl kaum noch vorkommen wird, +c dass der Triggerdetektor verdreht wird, sollte diese Einschraenkung jedoch +c keine grossen Auswirkungen haben. +c Ist der Triggerdetektor nicht im Strahl, so wird der Anteil der Triggerfolie +c gleich Null gesetzt. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c zwischen KOORDINATENWECHSEL und Beginn der L2andFo-Mappe: (feldfrei) + +10 Gebiet = upToL2andFoMap + Steps = Steps + 1 + + dt = (xEnterMap_L2andFo - x(1)) / v(1) + t = t + dt + x(1) = xEnterMap_L2andFo + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + if (radiusQuad.GT.radiusQuad_L2) then ! Teilchen fliegt an L2 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der gemeinsamen Mappe von Linse 2 und dem Feld vor der Trigger- +c Detektor-Folie: + +11 Gebiet = upToExL2 ! Gebietsnummer fuer L2 setzen + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor.EQ.0. .OR. (U_L2.EQ.0. AND. U_F.EQ.0.)) then +c WRITE(*,*) 'HALLOHALLO!' +d dtmax_L2andFo = 0. +d dtmin_L2andFo = 0. + dt = (xEndLense_L2 - x(1)) / v(1) ! Zeit bis zum Linsenende + x(1) = xEndLense_L2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L2) then + destiny = code_wand + radiusQuad_ = radiusQuad_L2 + goto 5111 + endif + if (TriggerInBeam) then + Gebiet = upToEnTD ! Gebietsnummer fuer upToTD setzen + ! Zeit bis zum Mappenende (falls TD im Strahl: bis Triggerfolie) + dt = (xLeaveMap_L2andFo - xEndLense_L2) / v(1) + x(1) = xLeaveMap_L2andFo + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + radiusQuad_ = radiusQuad_Rohr + endif + endif + goto 5111 + endif + + dt = .5/v(1) + zaehler = 0 + reachedEndOfMap = .false. + + +c die Integrationsroutine will x bereits relativ zum Mappenanfang geliefert +c bekommen: + +5011 x(1) = x(1) - xEnterMap_L2andFo + call INTEGRATIONSSTEP_RUNGE_KUTTA_L2(dt) + x(1) = x(1) + xEnterMap_L2andFo + +d if (NTP_steps) then +d if (dt.LT.dtmin_L2andFo) then +d dtmin_L2andFo = dt +d x_dtmin_L2andFo(1) = x(1) +d x_dtmin_L2andFo(2) = x(2) +d x_dtmin_L2andFo(3) = x(3) +d endif +d if (dt.GT.dtmax_L2andFo) then +d dtmax_L2andFo = dt +d x_dtmax_L2andFo(1) = x(1) +d x_dtmax_L2andFo(2) = x(2) +d x_dtmax_L2andFo(3) = x(3) +d endif +d endif + +5111 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_))-help2)/help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (Gebiet.EQ.upToExL2) then ! ----> noch innerhalb von Linse 2 + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L2) then + destiny = code_wand + radiusQuad_ = radiusQuad_L2 + goto 5111 + endif + + if (x(1).LT.xEnterMap_L2andFo) then + if (v(1).LT.0) then ! reflektiert + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L2: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + call exit + endif + elseif (x(1).GT.xEndLense_L2) then ! Verlasse L2 + Gebiet = upToEnTD + endif + + else ! ----> zw. Linse 2 und TD-Folie: + +c if (x(1).EQ.xLeaveMap_L2andFo) then ! Verlasse Mappe + if (reachedEndOfMap) then ! Verlasse Mappe + +c WRITE(*,*) 'HALLO: x(1).EQ.xLeaveMap_L2andFo !!' + ! ==================================================== + ! muss in Integrationsroutine richtig abgestimmt sein! + ! ==================================================== + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + if (TriggerInBeam) then + ! rechne in Triggerkoordinaten um (Folie == x=0) + x(1) = 0 + goto 112 + else + goto bis_L3_Mappe + endif + endif + + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + radiusQuad_ = radiusQuad_Rohr + goto 5111 + endif + + endif + + if (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5011 ! naechster Integrationsschritt in gleicher Feldmappe + + endif ! if (lense2) then.... ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + if (.NOT.TriggerInBeam) goto bis_L3_Mappe + + +c zwischen Koordinatenwechselebene und Triggerfolie: (feldfrei) +12 Gebiet = upToEnTD + +c Die Anweisungen dieses Abschnitts verlaufen in weiten Teilen parallel zu denen +c von Linse 1. -> Fuer Kommentare zu diesen Bereichen siehe dort! + + if (Beschl_Faktor_FO.EQ.0. .OR. gridInFrontOfFoil) then + ! => keine Integration in der Folienmappe + Steps = Steps + 1 + help1 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene +d dtmin_FO = 0. +d dtmax_FO = 0. + +c - berechne Schnittpunkt der Trajektorie mit Ebene der Triggerfolie bzw. bei +c 'GridInFrontOfFoil' mit Ebene des Gitters vor der Triggerfolie: +c Folienebene : y'= (x_intersectTD - x') / Tan_alfaTD +c Trajektorie : y'= y + v(2)/v(1)*(x'-x) = y + help1*(x'-x) +c => Schnittpunkt: x'= (x_intersectTD/Tan_alfaTD - y + help1*x)/(help1 + 1/Tan_alfaTD) +c = (x_intersectTD + Tan_alfaTD*(help1*x-y))/(1+help1*Tan_alfaTD) +c (erste Gleichung hat Probleme bei Tan_alfaTD = 0!) + + if (atand(help1).EQ.alfaTD-90) then ! ueberpruefen<<<<<<<<<<<<<<<<<< + ! Teilchen fliegt parallel zur Folie => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + else ! help2 == neues x(1) + if (Tan_alfaTD.EQ.0) then + dt = (x_intersectTD-x(1)) / v(1) + x(1) = x_intersectTD + else + help2 = (x_intersectTD+Tan_alfaTD* + + (help1*xChangeKoord-x(2)))/(1+help1*Tan_alfaTD) + if (help2.LT.xChangeKoord) then + ! Teilchen fliegt 'steiler' als Folienebene + ! -> kein Schnittpunkt mit dt.gt.0 => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + else ! Bahntangente kreuzt Folienebene + dt = (help2-x(1)) / v(1) + x(1) = help2 + endif + endif + endif + +c -> Teilchenort in Folienebene bzw. bei 'GridInFrontOfFoil' in Ebene des +c geerdeten Gitters vor der Triggerfolie: + + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + +c Koordinatentransformation vom Kammersystem in das System des Triggerdetektors: +c (Ursprung in Folienmitte, x-Achse senkrecht zur Folie, y-Achse parallel zur +c Folie. Wenn der TD nicht verdreht ist, verlaufen die Achsen parallel zu +c denen des Kammersystems): + + if (alfaTD.NE.0) then + x(2) = (xTD-x(1))*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + if (.NOT.GridInFrontOfFoil) then + x(1) = 0 + else + ! -> berechne Schnittpunkt der Trajektorie mit Folienebene unter + ! der Annahme einer idealen Potentialrampe: + + if (aFoil.NE.0.) then + help1 = v(1)*v(1) + 2.*aFoil*(d_Grid_Folie) + if (help1.LT.0) then ! Reflektion noch vor Folie + dt = -2*v(1)/aFoil + t = t + dt + x(1) = - d_Grid_Folie + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/aFoil + ! (ergibt sich aus x=v*t+1/2*a*t**2 mit richtiger V.Z.-Wahl ('+')) + v(1) = v(1) + aFoil*dt + else + dt = d_Grid_Folie / v(1) + endif + + t = t + dt + x(1) = 0 ! im Triggersystem + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + endif ! if (GridInFrontOfFoil) ... + + goto 112 + +c............................................................................... + else ! (if Beschl_Faktor_FO.EQ.0 .OR. GridInFrontOfFoil) then ... + + ! => Integration in der Folienmappe: + ! alte Version: ab xChangeKoord wurde integriert, wobei das EFeld im + ! Bereich vor der Mappe als 0 zurueckgegeben wurde. + ! Ab Version 1.2.9: Bis Schnittpunkt der Trajektorie mit Beginn der + ! Potentialmappe wird extrapoliert, dann erst integriert: + + +c Einschub ab Version 1.2.9: *************************************************** + + Steps = Steps + 1 + help1 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene + +c - berechne Schnittpunkt der Trajektorie mit Beginn der Potentialmappe: +c Mappenebene : y'= (x_intersectTDMap - x') / Tan_alfaTD +c Trajektorie : y'= y + v(2)/v(1)*(x'-x) = y + help1*(x'-x) +c => Schnittpunkt: x'= (x_intersectTDMap/Tan_alfaTD - y + help1*x)/(help1 + 1/Tan_alfaTD) +c = (x_intersectTDMap + Tan_alfaTD*(help1*x-y))/(1+help1*Tan_alfaTD) +c (erste Gleichung hat Probleme bei Tan_alfaTD = 0!) + + if (atand(help1).EQ.alfaTD-90) then ! ueberpruefen<<<<<<<<<<<<<<<<<< + ! Teilchen fliegt parallel zur Mappe => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + + ! stimmt so u.U. noch nicht ganz. Kommt aber eigentlich eh nie vor! + ! (stimmt bis jetzt wohl nur fuer positive alpha(TD) + + else + if (Tan_alfaTD.EQ.0) then + dt = (x_intersectTDMap-x(1)) / v(1) + x(1) = x_intersectTDMap + else + ! help2 == neues x(1): + help2 = (x_intersectTDMap+Tan_alfaTD* + + (help1*xChangeKoord-x(2)))/(1+help1*Tan_alfaTD) + ! folgendes herauskommentiert, da es teilweise passierte, dass + ! der Mappenanfang ueber xChangekoord hinausreichte und die + ! Trajektorien dann faelschlicherweise abgebrochen worden sind. + +c if (help2.LT.xChangeKoord) then +c ! Teilchen fliegt 'steiler' als Mappenebene +c ! -> kein Schnittpunkt mit dt.gt.0 => fliegt an TD vorbei +c destiny = code_vorbei +c goto 555 +c else ! Bahntangente kreuzt Mappenebene + dt = (help2-x(1)) / v(1) + x(1) = help2 +c endif + endif + endif + +c -> Teilchenort in Mappenebene: + + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c Ende des Einschubes ab Version 1.2.9: **************************************** +c => Jetzt erfolgt Start in die Folienmappe: + + reachedEndOfMap = .false. ! Folienebene wurde noch nicht erreicht + dt = .5/v(1) ! 1. Testschritt 0.5 mm in x-Richtung + zaehler = 0 + + +c Rechne in Folienmappen-Koordinaten um: + +5012 if (alfaTD.NE.0) then + help1= x(1)-xTD + x(1) = help1*Cos_alfaTD + x(2)*Sin_alfaTD + length1 + x(2) = -help1*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTd + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTd + else + x(1) = x(1) - length2 + endif + + +c mache Integrationssschritt: + + call INTEGRATIONSSTEP_RUNGE_KUTTA_FO(dt) + +d if (NTP_steps) then +d if (dt.LT.dtmin_FO) then +d dtmin_FO = dt +d x_dtmin_FO(1) = x(1) +d x_dtmin_FO(2) = x(2) +d x_dtmin_FO(3) = x(3) +d endif +d if (dt.GT.dtmax_FO) then +d dtmax_FO = dt +d x_dtmax_FO(1) = x(1) +d x_dtmax_FO(2) = x(2) +d x_dtmax_FO(3) = x(3) +d endif +d endif + + +c Rechne in Kammerkoordinaten zurueck: + + if (alfaTD.NE.0) then + help1= x(1)-length1 + x(1) = help1*Cos_alfaTD - x(2)*Sin_alfaTD + xTD + x(2) = help1*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + length2 + endif + + Steps = Steps + 1 ! neuer Ort, Zeit und Geschwindigkeit sind festgelegt + +c do some tests: + + if (destiny.EQ.code_dtSmall) then ! n_dtSmall>maxBelowDtSmall + goto 555 + endif + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then ! aufgeschlagen + help1 = v(2)*v(2)+v(3)*v(3) ! -> den Ort berechnen, an + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (destiny.EQ.code_reflektiert) then ! reflektiert + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'FO-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + if (reachedEndOfMap) then ! Folienebene erreicht + ! rechne in Triggerkoordinaten um (Folie == x=0) + if (alfaTD.NE.0) then + x(2) = (xTD-x(1))*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + x(1) = 0 + goto 112 + endif + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5012 ! naechster Integrationsschritt in FELD VOR FOLIE + +c............................................................................... + endif ! (if Beschl_Faktor_FO.EQ.0) then ... + +c Einsprunglabel fuer Starts auf der Triggerfolie mit Startwinkelangaben +c im Kammersystem => transformiere Geschwindigkeitsvektor in das Triggersystem: + +111 if (alfaTD.NE.0) then + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + +c - pruefe, ob das Projektil die Folie trifft: + +112 radiusQuad = x(2)*x(2) + x(3)*x(3) + If (radiusQuad.GT.radiusQuad_Folie) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + destiny = code_vorbei + goto 555 + endif + + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das 'FoilFile': +c (hier ist sichergestellt, dass die Folie getroffen worden ist, Wechsel- +c wirkungen mit der Folie wurden aber noch nicht beruecksichtigt). +c HIER WERDEN 'X' UND 'V' IM TRIGGERSYSTEM ABGESPEICHERT! + + if (createFoilFile) then + ! falls die Flugzeit bis zur Triggerfolie verschmiert in das + ! NTupel aufgenommen werden soll: + if (smearS1Fo) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = t + help4 + endif + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + call HFNT(NTP_write) + NTPalreadyWritten = .true. + endif + + +c - Zeitpunkt bei Erreichen der Folie sichern: + +113 S1Fo = t + if (createNTP.AND.Fo_triggered) fill_NTP = .true. + if (statNeeded(Nr_S1Fo)) call fill_statMem(S1Fo,Nr_S1Fo) + + + +c - Speichern der Koordinaten fuer die Statistiken: + + if (statNeeded(Nr_y_Fo)) then + call fill_statMem( x(2),Nr_y_Fo) + endif + if (statNeeded(Nr_z_Fo)) then + call fill_statMem( x(3),Nr_z_Fo) + endif + if (statNeeded(Nr_r_Fo)) then + radius = SQRT(x(2)*x(2) + x(3)*x(3)) + call fill_statMem(radius,Nr_r_Fo) + endif + + +c - speichere Auftreffort des Projektils fuer die Berechnung der Folienelektronen: + + if (generate_FE) then + x0FE(1) = x(1) + x0FE(2) = x(2) + x0FE(3) = x(3) + endif + + +c - falls nur bis zur Folie gerechnet werden soll, beende hier die Integration: + + if (upToTDFoilOnly) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + if (generate_FE) Gebiet = UpToExTD + goto 555 + endif + + +c - pruefe, ob das Projektil auf das Stuetzgitter aufschlaegt: + + if (testOnWireHit .AND. ran(seed).GT.TransTDFoil) then + destiny = code_Stuetzgitter + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + goto 555 + endif + + +c - Energieverlust und Winkelaufstreuung: + + if (log_E_Verlust .OR. log_Aufstreu) then + if (Debug_) then + Steps = Steps + 1 + call Output_Debug + endif + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + v_Betrag = SQRT(v_square) + Ekin = v_square * Energie_Faktor + endif + +c -- Energieverlust (vorerst nur Gaussverteilt): + + if (log_E_Verlust_defined.OR.log_Meyer_Gauss) then + ! Berechne Bahnwinkel relativ zur Folienebene fuer effektive Folien- + ! dicke: + alfa = atand(SQRT(v(2)*v(2)+v(3)*v(3))/v(1)) + endif + + if (log_E_Verlust) then + if (calculate_each) then + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,E_Verlust) + else + E_Verlust = mean_E_Verlust + endif + if (log_E_Verlust_defined) E_Verlust = E_Verlust / cosd(alfa) + if (debug_) write (lunLOG,*) ' mittlerer Energieverlust: ',E_Verlust + + ! Now we have the mean energy loss. We still have to modify it + ! according to the distribution of energy losses, i.e. + ! E_Verlust -> E_Verlust + delta_E_Verlust: + + delta_E_Verlust = 0. + if (log_E_Straggling_sigma) then +400 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 400 + elseif (log_E_Straggling_equal) then +410 delta_E_Verlust = lowerE + (upperE - lowerE)*ran(seed) + if (E_Verlust+delta_E_Verlust.LT.0) goto 410 + elseif (log_E_Straggling_Lindhard) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie: + call E_Straggling_Lindhard(Ekin-0.5*E_Verlust,m,sigmaE) +420 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 420 + elseif (log_E_Straggling_Yang) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie! + call E_Straggling_Yang(Ekin-0.5*E_Verlust,m,sigmaE) +430 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 430 + endif + + if (E_Verlust+delta_E_Verlust.GE.Ekin) then + destiny = code_stopped_in_foil + goto 555 + endif + E_Verlust = E_Verlust + delta_E_Verlust + + ! help1 == Reduzierungsfaktor fuer Geschw.Betrag + help1 = sqrt( (Ekin - E_Verlust)/Ekin ) + v(1) = help1 * v(1) + v(2) = help1 * v(2) + v(3) = help1 * v(3) + v_Betrag = help1 * v_Betrag + if (debug_) write (lunLOG,*) ' Energieverlust: ',E_Verlust + endif + +c -- Winkelaufstreuung (vorerst nur Gaussverteilt): + + if (log_aufstreu) then + if (log_Meyer_F_Function) then + call throwMeyerAngle(thetaAufstreu) + else + if (log_Meyer_Gauss) then + if (log_E_Verlust) Ekin = Ekin - .5 * E_Verlust ! mittlere Energie + effRedThick = Meyer_Faktor1 * Thickness / cosd(alfa) + call g_Functions(g1,g2,effRedThick) + sigmaAufstreu = Meyer_Faktor2 / Ekin * (g1 + Meyer_Faktor3*g2) + if (debug_) then + write (lunLOG,*) ' effekt. red. Dicke: ',effRedThick + write (lunLOG,*) ' Sigma(Streuwinkel): ',sigmaAufstreu + endif + endif + + call Gauss_Verteilung_theta(sigmaAufstreu,thetaAufstreu) + endif + + st0 = sind(thetaAufstreu) + ct0 = cosd(thetaAufstreu) + phiAufstreu = 360.*ran(seed) + + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) ! v_xy stets groesser 0 + ! wegen v(1)>0 + + help1 = v(1) + help2 = v(2) + help3 = v_Betrag*st0*cosd(phiAufstreu)/v_xy + help4 = st0*sind(phiAufstreu) + + v(1) = ct0*help1 - help3*help2 - help4*help1*v(3)/v_xy + v(2) = ct0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = ct0*v(3) + help4*v_xy + if (debug_) write (lunLOG,*) ' Aufstreuung: theta, phi =', + + thetaAufstreu,phiAufstreu + endif + + if (Debug_ .AND. (log_E_Verlust .OR. log_Aufstreu)) then + call Output_Debug + endif + + +c - Neutralisierung in der Folie? + + if (log_neutralize) then + if (neutral_fract(q_).EQ.-1.0) then + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + Ekin = v_square * Energie_Faktor + call chargeStateYields(Ekin,m,YieldPlus,YieldNeutral) + YieldNeutral = 100. * YieldNeutral + else + YieldNeutral = neutral_fract(q_) + endif + if (100.*ran(seed).LE.YieldNeutral) then + q = 0. + qInt = 0 + if (debug_) then + write (lunLOG,*) ' Teilchen wurde neutralisiert' + endif + nNeutral = nNeutral + 1 + else + nCharged = nCharged + 1 + endif + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c im TriggerDetektor: (homogene Felder) + + +13 Gebiet = upToExTD + Steps = Steps + 1 + +c der Weg des Projektils innerhalb der Triggerkammer: + + call TRIGGER(m,q,t,x,v,Debug_,graphics_,n_return) + + +c Koordinatentransformation vom System des Triggerdetektors in das Kammersystem: +c ('d_Achse_Ground' == Abstand zwischen TD-Achse und 'Ground'-Gitter) + + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + +c Was ist im TD mit dem Teilchen passiert? + + if (n_return.NE.0) then ! -->> das Projektil kam nicht bei GROUND an + if (n_return.GT.100 .AND. n_return.LE.120) then ! -> abgebrochen + statTD(1,n_return-100) = statTD(1,n_return-100)+1 ! Grund notieren + destiny = code_lostInTD ! im TD verloren + elseif (n_return.GT.0..AND.n_return.LE.75) then ! -> pfosten getroffen! + pfostenHit(n_return,1) = pfostenHit(n_return,1)+1 + destiny = code_wand + elseif (n_return.EQ.-5) then ! -> im TD auf Gitterstab + statTD(1,17) = statTD(1,17)+1 ! + destiny = code_grid + elseif (n_return.EQ.-9) then ! -> NICHT im MCP3 registriert + statTD(1,18) = statTD(1,18)+1 ! + destiny = code_notRegInM3 + elseif (n_return.EQ.-10) then ! -> im MCP3 registriert + statTD(1,16) = statTD(1,16)+1 ! '16' zaehlt MCP3-Treffer + destiny = code_wand + endif + goto 555 ! naechstes Projektil + else ! -->> das Projektil kam bei GROUND an + statTD(1,15) = statTD(1,15)+1 ! '15' zaehlt GROUND-Treffer + endif + + if (useDecay_) call Decay_Test(*555) + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen KOORDINATENWECHSEL BZW. GROUND-GITTER und Beginn der L3-Mappe: +c (feldfrei) + +14 Gebiet = upToL3Map + Steps = Steps + 1 + + dt = (xEnterMap_L3 - x(1)) / V(1) + t = t + dt + x(1) = xEnterMap_L3 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + if (radiusQuad.GT.radiusQuad_L3) then ! Teilchen fliegt an L3 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb L3: (inhom. Felder -> Integrationen) + + +15 Gebiet = upToExL3 ! Gebietsnummer fuer L3 setzen + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_L3.EQ.0. .OR. q.EQ.0) then ! q=0 -> in Folie neutralisiert +d dtmax_L3 = 0. +d dtmin_L3 = 0. + dt = (xLeaveMap_L3 - x(1)) / v(1) ! Zeit bis zum Mappenende + x(1) = xLeaveMap_L3 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L3) destiny = code_wand + goto 5115 + endif + + dt = .5/v(1) + zaehler = 0 + +5015 call INTEGRATIONSSTEP_RUNGE_KUTTA_L3(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_L3) then +d dtmin_L3 = dt +d x_dtmin_L3(1) = x(1) +d x_dtmin_L3(2) = x(2) +d x_dtmin_L3(3) = x(3) +d endif +d if (dt.GT.dtmax_L3) then +d dtmax_L3 = dt +d x_dtmax_L3(1) = x(1) +d x_dtmax_L3(2) = x(2) +d x_dtmax_L3(3) = x(3) +d endif +d endif + +5115 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_L3))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L3-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (x(1).LT.xEnterMap_L3) then + if (v(1).LT.0) then ! reflektiert? + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L3: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + STOP + endif + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + elseif (x(1).GE.xLeaveMap_L3) then ! Verlasse L3 + dt = (xLeaveMap_L3 - x(1))/v(1) ! rechne zurueck auf exaktes + t = t + dt ! Mappenende + x(1) = xLeaveMap_L3 + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + goto bis_MCP2_Mappe +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L3-2: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5015 ! naechster Integrationsschritt in gleicher Feldmappe + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen L3-Mappe und MCP2-Mappe (feldfrei) + + +16 Gebiet = upToM2Map + + if (x(1).EQ.xEnterMap_M2) goto MCP2_Mappe + Steps = Steps + 1 + + dt = (xEnterMap_M2 - x(1)) / v(1) + + t = t + dt + x(1) = xEnterMap_M2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c vor MCP2: (inhom. Felder -> Integrationen) + +17 Gebiet = upToMCP2 + +c Beruecksichtige gegebenenfalls die Flugzeit in 'delta_L2', welches 'vor dem +c MCP2' eingeschoben werden kann. Addiert wird vorerst nur die Flugzeit in +c dieser zusaetzlichen Flugstrecke. Korrekterweise muessten alle nachfolgenden +c Positionen um 'delta_L2' verschoben werden. Dies zu implementieren ist +c allerdings momentan aus Zeitgruenden nicht moeglich. + + dt = Delta_L2 / v(1) + t = t + dt + + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_M2.EQ.0. .OR. q.EQ.0) then ! q=0 -> in Folie neutralisiert +d dtmax_M2 = 0. +d dtmin_M2 = 0. + if (xBlende.GT.x(1)) then + dt = (xBlende - x(1)) / v(1) ! Zeit bis zur Blende + x(1) = xBlende + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + elseif (radiusQuad.GE.radiusQuad_Blende) then + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_hitBlende + goto 555 + endif + endif + dt = (xMCP2 - x(1)) / v(1) ! Zeit bis MCP2 + x(1) = xMCP2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) destiny = code_wand + reachedEndOfMap = .true. + goto 5117 + endif + + dt = .5/v(1) + + reachedEndOfMap = .false. + zaehler = 0 + if (xBlende.GT.0) check_Blende = .true. + +5017 call INTEGRATIONSSTEP_RUNGE_KUTTA_M2(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_M2) then +d dtmin_M2 = dt +d x_dtmin_M2(1) = x(1) +d x_dtmin_M2(2) = x(2) +d x_dtmin_M2(3) = x(3) +d endif +d if (dt.GT.dtmax_M2) then +d dtmax_M2 = dt +d x_dtmax_M2(1) = x(1) +d x_dtmax_M2(2) = x(2) +d x_dtmax_M2(3) = x(3) +d endif +d endif + +5117 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (check_Blende.AND.x(1).GE.xBlende) then + dt = (xBlende - x(1)) / v(1) ! zurueck zur Blende ... + x(1) = xBlende + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GE.radiusQuad_Blende) then + destiny = code_hitBlende + goto 555 + endif + dt = -dt ! ... wieder zum aktuellen Ort + x(1) = xBlende + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + check_Blende = .false. + elseif (destiny.EQ.code_wand) then + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (destiny.EQ.code_reflektiert) then ! reflektiert + goto 555 + elseif (reachedEndOfMap) then ! MCP2-Ebene erreicht +c if (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'M2 ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP +c endif + if (createNTP.AND.xM2_triggered) fill_NTP = .true. + S1xM2 = t + if (statNeeded(Nr_S1xM2))call fill_statMem(S1xM2,Nr_S1xM2) + radiusQuad = x(2)*x(2) + x(3)*x(3) + radius = SQRT(radiusQuad) + if (statNeeded(Nr_y_xM2)) call fill_statMem( x(2),Nr_y_xM2) + if (statNeeded(Nr_z_xM2)) call fill_statMem( x(3),Nr_z_xM2) + if (statNeeded(Nr_r_xM2)) call fill_statMem(radius,Nr_r_xM2) + if (radiusQuad.LE.radiusQuad_MCP2active) then + S1M2 = t ! Zeiten werden sowohl fuer Statistiken + FoM2 = t - S1Fo ! als auch fuer NTupel benoetigt + if (statNeeded(Nr_S1M2)) call fill_statMem(S1M2,Nr_S1M2) + if (statNeeded(Nr_FoM2)) call fill_statMem(FoM2,Nr_FoM2) + if (createNTP.AND.M2_triggered) fill_NTP = .true. + if (statNeeded(Nr_y_M2)) call fill_statMem( x(2),Nr_y_M2) + if (statNeeded(Nr_z_M2)) call fill_statMem( x(3),Nr_z_M2) + if (statNeeded(Nr_r_M2)) call fill_statMem(radius,Nr_r_M2) + else ! am MCP2 vorbei + if (radiusQuad.LE.radiusQuad_MCP2) then + destiny = code_hitMCP2inactive + else + destiny = code_vorbei + if (Graphics_) then ! Damit diese Trajektorie 40mm ueber die + nKoord = nKoord + 1 ! MCP2-Ebene hinausgezeichnet wird + dt = 40./v(1) + t = t + dt + xKoord(nKoord) = x(1)+40. + yKoord(nKoord) = x(2)+v(2)*dt + zKoord(nKoord) = x(3)+v(3)*dt + goto 556 + endif + endif + endif + + goto 555 + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5017 ! naechster Integrationsschritt im Feld vor MCP2 + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER IST DER PROGRAMMKODE FUER DIE TRAJEKTORIENBERECHNUNG +c DER PROJEKTILE BEENDET! +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +555 if (Graphics_) call Save_Graphics_Koord +556 if (Debug_) call Output_Debug + + +c Gib Trajektorie in Graphikfenster aus: + + if (Graphics_) then + if (Gebiet.LE.upToChKoord) then ! Bahnberechnung wurde vor + call plot_horizontal ! Koordinatenwechsel abgebrochen + if (schnitt_p.eq.1) call schnitt + else + call plot_vertikal + if (schnitt_p.eq.2) call schnitt + endif + nKoord = 0 + endif + + +c Pruefe, ob Teilchen reflektiert wurde: + + if ((Gebiet.EQ.upToExL1 .OR. Gebiet.EQ.upToEnTD .OR. + + Gebiet.EQ.upToExL3 .OR. Gebiet.EQ.upToMCP2) .AND. + + v(1).LE.0.) then + destiny = code_reflektiert + endif + + +c Zaehle mit, bei wie vielen Teilchen trotz dtMaxStep abgebrochen werden: + + if (destiny.EQ.code_lostInTD) then + lostInTD_counter = lostInTD_counter + 1 + elseif (destiny.EQ.code_lost) then + lost_counter = lost_counter + 1 + endif + + +c bei DEBUG: Ausgabe des Teilchenschicksals und des aktuellen Gebiets: + + if (debug_) then + indx = index(code_text(destiny),':') + if (indx.EQ.0) then + write(lun(1),*) 'destiny : ',code_text(destiny) + else + write(lun(1),*) 'destiny : ',code_text(destiny)(1:indx-1) + endif + indx = index(Gebiet_text(Gebiet),':') + if (indx.EQ.0) then + write(lun(1),*) 'Gebiet : ',Gebiet_text(Gebiet) + else + write(lun(1),*) 'Gebiet : ',Gebiet_text(Gebiet)(1:indx-1) + endif + endif + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER STARTEN DIE FOLIENELEKTRONEN +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + if (generate_FE) then ! ~~~ 1: if ~~~~~~~~~~~~ + if (Gebiet.GE.UpToExTD) then ! ~~~ 2: if ~~~~~~~~~~~~ + +c sekundaerelektronen + nFE = int(4.*ran(seed))+2 ! Anzahl wuerfeln: [2,5] + tFE_min = 0. ! tFE_min: kuerzeste FE-Flugzeit: + ! bekam noch keinen Wert zugewiesen + +c - die Laufzeiten der Folienelektronen: +c +c---------------------------------------- +c +c-TP-10/2000 reset of end positions of electrons +c + do k = 1, 3 + xFE_MCP(k) = 0. + yFE_MCP(k) = 0. + zFE_MCP(k) = 0. + enddo +c +c---------------------------------------- +c + + do 450, k = 1, nFE + + xFE(1) = x0FE(1) + xFE(2) = x0FE(2) + xFE(3) = x0FE(3) + + E0FE = 0.003*ran(seed) ! Start-Energie wuerfeln: [0,3) eV + v_Betrag = sqrt(2.*E0FE/511.015)*c ! Startgeschwindigkeit + call Lambert_Verteilung(1.,ct0,st0) ! Startwinkel wuerfeln + f0 = 360.*ran(seed) + cf0 = cosd(f0) + sf0 = sind(f0) + vFE(1) = v_Betrag * ct0 ! Geschwindigkeitskomponenten + vFE(2) = v_Betrag * st0*cf0 + vFE(3) = v_Betrag * st0*sf0 + + tFE = 0. + + nKoord = 0 + start_nr(2) = start_nr(2) + 1 ! (2): FE + call TRIGGER(511.015,-1.,tFE,xFE,vFE,DEBUG_FE.AND.Debug_, + + plot_FE,n_return) + if (plot_FE) call plot_vertikal + + if (n_return.NE.-10) then +C - das FE kam nicht am MCP3 an -> + if (n_return.GT.100 .AND. n_return.LE.120) then ! -> abgebrochen + statTD(2,n_return-100) = statTD(2,n_return-100)+1 ! Grund notieren + elseif (n_return.GT.0 .AND. n_return.LE.75) then ! -> pfosten getroffen! + pfostenHit(n_return,2) = pfostenHit(n_return,2)+1 + elseif (n_return.EQ.0) then ! -> GROUND getroffen + statTD(2,15) = statTD(2,15)+1 ! '15' zaehlt GROUND-Treffer + elseif (n_return.EQ.-5) then ! -> im TD auf Gitterstab + statTD(2,17) = statTD(2,17)+1 + elseif (n_return.EQ.-9) then ! -> NICHT im MCP3 registriert + statTD(2,18) = statTD(2,18)+1 + endif + tFE_(k) = -1 ! -1: FE kam nicht bei MCP3 an +c +c--------------------------------------- +c +c-TP-10/2000 +c + xFE_MCP(k) = -100. + yFE_MCP(k) = -100. + zFE_MCP(k) = -100. +c +c--------------------------------------- +c + goto 450 ! naechstes FE + + endif + +c - das FE kam beim MCP3 an -> + + statTD(2,16) = statTD(2,16)+1 ! '16' zaehlt MCP3-Treffer + tFE_(k)=int(1000.*tFE) ! tFE in ps. (braucht als Integer + ! weniger Speicherplatz) +c +c--------------------------------------- +c +c-TP-10/2000 +c + xFE_MCP(k) = xFE(1) + yFE_MCP(k) = xFE(2) + zFE_MCP(k) = xFE(3) +c +c--------------------------------------- +c + + + +c fuer die Statistik: die Flugzeiten saemtlicher das MCP3 erreichender FE abspeichern: + + if (statNeeded(Nr_t_FE)) call fill_statMem(tFE,Nr_t_FE) + + +c kuerzeste Elektronenflugzeit fuer das aktuelle Projektilteilchen notieren: + + if (tFE_min.EQ.0. .OR. tFE.LT.tFE_min) tFE_min = tFE + + +450 continue ! -> naechstes Folienelektron + + +c die Flugzeiten der nicht gestartenen Folienelektronen (nFE+1 bis 5) auf 0. setzen: + + do while (nFE.LT.5) + nFE = nFE + 1 + tFE_(nFE) = 0. + enddo + + +c Jetzt sind die Folienelektronen durchgelaufen. + +c Fuelle Statistiken fuer die 'gemessenen' Teilchenflugzeiten (mit Beruecksichti- +c gung der Flugzeiten der Folienelektronen). M3M2 aber nur, wenn MCP2 auch +c getroffen wurde: + + if (tFE_min.NE.0.) then + S1M3 = S1Fo + tFE_min ! +, da Stop verzoegert + if (statNeeded(Nr_S1M3)) then + call fill_statMem(S1M3,Nr_S1M3) + endif + if (destiny.EQ.code_ok) then + M3M2 = FoM2 - tFE_min ! -, da Start verzoegert + if (statNeeded(Nr_M3M2)) call fill_statMem(M3M2,Nr_M3M2) + endif + endif + + else ! ~~~ 2: else ~~~~~~~~~~ + + do k= 1, 5 + tFE_(k) = 0. ! nicht gestartet + enddo + + endif ! ~~~ 2: endif ~~~~~~~~~ + endif ! ~~~ 1: endif~~~~~~~~~~ + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c ES FOLGEN DATENAUSGABE, SPRUNG IN NEUE SCHLEIFE UND PROGRAMMENDE +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c trage das NTupel ein: + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das NTupel: +c (falls bei 'createFoilFile' 'NTPalreadyWritten' nicht gesetzt ist schied +c dieses Teilchen schon vor der Triggerfolie aus. Ist es dagegen gesetzt wurden +c die Trajektoriendaten mit dem Erreichen der Triggerfolie abgespeichert um sie +c in den im Triggersystem gueltigen Werten zu haben): + + if (fill_NTP .OR. createFoilFile) then + if (NTPalreadyWritten) then + NTPalreadyWritten = .false. + else + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + if (smearS1Fo .AND. .NOT.use_MUTRACK) then + if (s1fo.NE.0) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = S1Fo + help4 + else + S1FoOnly = 0. + endif + endif + FoM2Only = FoM2 + call HFNT(NTP_write) + endif + endif + + +c Nimm das Schicksal des Teilchens in den zugehoerigen Statistikspeicher auf: + + if (destiny.GT.0) destiny = destiny + (Gebiet-1)*highest_code_Nr + statDestiny(destiny) = statDestiny(destiny) + 1 + + if (destiny.EQ.code_ok) okStepsCounter = okStepsCounter + steps + + +c -> das naechste Projektil kann kommen +100 continue + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Jetzt sind alle Projektile dieser Schleife abgearbeitet! + +c Mittlere Anzahl an Integrationsschritten fuer Trajektorien mit destiny = +c 'code_ok' ausgeben: + + if (statDestiny(code_ok).NE.0) then + write(*,'(6x,A,F7.2)')'Mittlere Anzahl an Integrationsschritten bis zum Ziel: ', + + real(okStepsCounter)/real(statDestiny(code_ok)) + endif + +c das Summary ausgeben und die Werte in die Tabellen schreiben: +c Falls nur ein Teilchenstart pro Schleife erfolgt, werte die Statistiken +c erst nach der letzten Schleife aus: + + NotLastLoop = .NOT.(SchleifenNr.EQ.SchleifenZahl) + flag_ok = .NOT.(OneStartPerLoop.AND.NotLastLoop) + + if (flag_ok) then + call eval_statistics + if (n_outWhere.GT.0 .OR. smallLogFile) call Summary + if (createTabellen .or. createPhysTab) call output_tabellen + endif + + +c das PostScript-file erstellen: + +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Das Postskript braucht dann also erst bei der letzten Schleife +c erstellt zu werden: + + if (GRAPHICS .AND. flag_ok) then + call schnitt_plot ! Ausgabe der Graphik der Schnittebene + + if (n_postSkript.LE.0) then + goto 620 + elseif (n_postSkript.EQ.1) then + if (n_outWhere.LT.2) then + write(*,*)'.....................................'// + + '.........................................' + write(*,'(2X,A18,I3,A,I3)')'Schleife ', + + SchleifenNr,' von ',SchleifenZahl + endif + write(*,1003)'(P) Ps-file erstellen', + + '(R) Restliche ps-files erstellen' + write(*,1003)'(N) ps-file Nicht erstellen', + + '(K) Keine ps-files mehr erstellen' + write(*,1003)'(G) Graphikausgabe beenden', + + '(A) programm Abbrechen' +1003 format(T6,A,T40,A) + + helpChar = 'n' +600 write(*,1004)' [RETURN] = (N) -> ' +1004 format($,x,A) + read(*,'(A)') helpChar + + do i = 1,7 ! bis zu sechs blanks werden akzeptiert + ant = helpChar(i:i) + if (ant.NE.' ') goto 610 + enddo + ant = 'N' + +610 write(*,*)'==========================='// + + '=====================================================' + + call str$upcase(ant,ant) + if (ant.EQ.'N') then + goto 620 + elseif (ant.EQ.'R') then + n_postSkript = 2 + elseif (ant.EQ.'K') then + n_postSkript = 0 + goto 620 + elseif (ant.EQ.'G') then + call HPLEND + GRAPHICS = .false. + goto 200 + elseif (ant.EQ.'A') then + call HPLEND + call TERMINATE_OUTPUT + STOP + elseif (ant.NE.'P') then + goto 600 + endif + endif + + write (helpChar(1:7),'(''_'',I6)') SchleifenNr + if (filename.NE.' ') then + call MAKE_PS(filename//helpChar) + else + call MAKE_PS('MUTRACK'//helpChar) + endif + + +620 continue + + CALL IZPICT ('CHAM_1','S') ! LOESCHEN DER BILDER IM PAWC-COMMON-BLOCK + CALL IZPICT ('CHAM_2','S') + CALL IZPICT ('HISTO','S') + CALL IZPICT ('TEXT','S') + + call iclrwk (1,flag_ok) ! CLEAREN DER WORKSTATIONS + call iclrwk (3,flag_ok) + call iclrwk (4,flag_ok) + call iclrwk (5,flag_ok) + + CALL HRESET (50,' ') ! RESETTEN DES HISTOGRAMMS + + endif + +c -> das gleiche von vorne mit neuen Settings (d.h. neue Schleife) + +200 continue +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Jetzt sind alle Schleifen abgearbeitet -> fertigmachen zum Programmende: + +c - HIGZ-Graphikbibliothek schliessen: + + if (Graphics) call HPLEND + +c - HBOOK-Datei schliessen: + + if (.NOT.fromScratch) then + if (use_ACCEL) then + call HREND('ACCEL') + elseif (Use_MUTRACK) then + call HREND('MUread') + endif + close (lunRead) + endif + + call TERMINATE_OUTPUT + + + END + + +C=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Lambert_Verteilung(n_Lambert,cos_theta,sin_theta) +c ============================================================ + + IMPLICIT NONE + + real cos_theta,sin_theta + + real n_Lambert ! Ordnung der Lambert-Verteilung + real randomVar + integer seed + common /seed/ seed + + randomVar = ran(seed) + + if (n_Lambert.EQ.0.) then + cos_theta = (1.-randomVar) + sin_theta = sqrt(1.-cos_theta*cos_theta) + elseif (n_Lambert.EQ.1.) then + cos_theta = sqrt(1.-randomVar) + sin_theta = sqrt(randomVar) + else + cos_theta = (1.-randomVar)**(1./(n_Lambert + 1)) + sin_theta = sqrt(1.-cos_theta*cos_theta) + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung(sigma,wert) +c ======================================= + + IMPLICIT NONE + + real sigma ! Breite der Gaussverteilung + real wert ! gewuerfelte Returnvariable + real radius,phi + + integer seed + common /seed/ seed + + real zwoPi + parameter (zwoPi = 2.*3.1415927) + +c Da die eindimensionale Gaussfunktion nicht integrierbar ist, wird erst +c ein Punkt in der Ebene mit der entsprechenden zweidimensionalen Gaussfunktion +c gewuerfelt. Von diesem Punkt wird dann die x-Komponente zurueckgegeben, die +c eindimensional Gaussverteilt ist: + + radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = zwoPi * ran(seed) + wert = radius * cos(phi) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung_theta(sigma,theta) +c ============================================== + + IMPLICIT NONE + + real sigma,theta + real radius,phi,ratio + + integer i, seed + common /seed/ seed + +c Man beachte, dass hier Winkel gewuerfelt werden! D.h., dass die Variable +c 'radius' einen Radius in einer 2dimensionalen 'Winkel'-Ebene darstellt. +c Es wird angenommen, dass sigma in degree angegeben wird (daher die sind()- +c Funktion in der Zuweisung fuer 'ratio' anstelle der sin()-Fkt.). + + i = 1 + +1 radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = 360.*ran(seed) + theta = abs(radius * cosd(phi)) + ! nur theta zwischen 0 und 90 deg sollen eine Chance haben: + if (theta.GT.90) then + i = i + 1 + if (i.LE.10000) then + goto 1 + else + write(*,*) + write(*,*) 'SUBROUTINE Gauss_Verteilung_theta:' + write(*,*) ' Nach 10000 Versuchen noch keinen Winkel < 90 degree gewuerfelt.' + write(*,*) ' Vorgegebenes Sigma der Winkelverteilung: ',sigma + write(*,*) + STOP + endif + endif + +c Zitat aus TP's 'TESTSEED.FOR', aus welchem diese Routine abgeschrieben +c ist: +c +c Now we habe a GAUSSIAN, but we need for multiple scattering +c GAUSSIAN*SIN(x) =: g(x). This is not integrateable analytically, but +c we can choose the VON NEUMANN REJECTION to get what we want. +c As auxiliary function we choose the GAUSSIAN =: f(x), because it +c satisfies g(x) <= f(x) for all x. +c We must build the ratio g(x)/f(x) = sin(x) and compare it to +c another random number: + + ratio = sind(theta) + if (ran(seed).GT.ratio) goto 1 ! Verteilung zurechtbiegen + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE G_Functions(G1,G2,tau) +c ================================= + +c Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau' +c Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von +c Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts- +c breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253 +c (1971)) + + IMPLICIT NONE + + real tau,g1,g2 + real tau_(26),g1_(26),g2_(26) + real help + + integer i + + DATA tau_ /0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, + + 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0, + + 10.0, 12.0, 14.0, 16.0, 18.0, 20.0 / + + DATA g1_ /0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575, + + 0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850, + + 1.990,2.270,2.540,2.800,3.050,3.290 / + DATA g2_ / 0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59, + + 0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32, + + 0.30,0.26,0.22,0.18,0.15,0.13 / + + if (tau.LT.tau_(1)) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist kleiner als kleinster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(1) = ',tau_(1) + write(*,*) + STOP + endif + + i = 1 + +10 i = i + 1 + if (i.EQ.27) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist groesser als groesster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(26) = ',tau_(26) + write(*,*) + STOP + elseif (tau.gt.tau_(i)) then + goto 10 + endif + + +c lineare Interpolation zwischen Tabellenwerten: + + help = (tau-tau_(i-1))/(tau_(i)-tau_(i-1)) + + g1 = g1_(i-1) + help*(g1_(i)-g1_(i-1)) + g2 = g2_(i-1) + help*(g2_(i)-g2_(i-1)) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine Get_F_Function_Meyer(tau,Ekin) +c ========================================= + + implicit none + + real tau + real Ekin + + real thetaSchlange,thetaSchlangeMax + real theta,thetaMax,thetaStep + real f1,f2,F + + +c------------------------------------ +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target +c real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + + real Pi ! die Kreiszahl + +c parameter (a0 = 5.29E-9) + parameter (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10) + parameter (Pi = 3.141592654) + + real Meyer_Faktor3 + real Meyer_Faktor4 + real zzz ! 'Hilfsparameter' + real Meyer_Faktor5 + + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare) * Pi/180.) + parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare)) + parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi)) + +c------------------------------------ + + integer nBin,nBinMax + parameter (nBinMax=201) + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + integer i + real rhelp + + integer HB_memsize + parameter(HB_memsize=500000) + real memory(HB_memsize) + COMMON /PAWC/ memory + + +c nur noch fuer Testzwecke: + + real fValues(203) + real fValuesFolded(203) + + integer idh + parameter (idh = 50) + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + character filename*20 ! Name der Ausgabe-Dateien + COMMON /filename/ filename + +c------------------------------------------------------------------------------- + +c Festlegen des maximalen Theta-Wertes sowie der Schrittweite: + + if (tau.LT.0.2) then + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP' + call exit + elseif (tau.LE.2.) then + ! => Tabelle A + thetaSchlangeMax = 4.0 + elseif (tau.LE.8.) then + ! => Tabelle B + thetaSchlangeMax = 7.0 + elseif (tau.LE.20.) then + ! => Tabelle C + thetaSchlangeMax = 20.0 + else + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP' + call exit + endif + + thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin + if (thetaMax.GT.50) then + thetaStep = .5 + elseif (thetaMax.GT.25) then + thetaStep = .25 + elseif (thetaMax.GT.12.5) then + thetaStep = .125 + else + thetaStep = .0625 + endif + + +c Tabelle der F-Werte erstellen: + + nBin = 0 + do theta = thetaStep, thetaMax, thetaStep + + ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich + ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen): + + thetaSchlange = Meyer_faktor4 * Ekin * theta + + ! Auslesen der Tabellenwerte fuer die f-Funktionen: + + call F_Functions_Meyer(tau,thetaSchlange,f1,f2) + if (thetaSchlange.EQ.-1) then + ! wir sind jenseits von thetaSchlangeMax + goto 10 + endif + + ! Berechnen der Streuintensitaet: + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + + nBin = nBin + 1 + if (nBin.GT.nBinMax) then + write(*,*) 'nBin > nBinMax => EXIT' + call exit + endif + value(nBin) = sind(theta)*F + + fValues(nBin+1) = F ! fuer Testzwecke + fValuesFolded(nBin+1) = sind(theta)*F ! fuer Testzwecke + + enddo + + +c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + +10 do i = 1, nBin + area(i) = (value(i)+value(i-1))/2. * thetaStep + integ(i) = integ(i-1) + area(i) + enddo + + +c Normiere totale Flaeche auf 1: + + rHelp = integ(nBin) + do i = 1, nBin + value(i) = value(i) / rHelp + area(i) = area(i) / rHelp + integ(i) = integ(i) / rHelp + enddo + + +c vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + ! Berechne die Werte fuer theta=0: + + call F_Functions_Meyer(tau,0.,f1,f2) + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + fValues(1) = F + fValuesFolded(1) = 0. + + ! Gib die Werte in das Tabellenfile aus: + +c theta = 0. +c open (10,file=outDir//':'//filename//'.TAB',status='NEW') +c do i = 1, nBin+1 +c write(10,*) theta, fValues(i), fValuesFolded(i) +c theta = theta + thetaStep +c enddo +c close (10) + + + ! Buchen und Fuellen der Histogramme: + + call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh,fValues) + call HRPUT(idh,outDir//':'//filename//'.RZ','N') + call HDELET(idh) + + call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh+1,fValuesFolded) + call HRPUT(idh+1,outDir//':'//filename//'.RZ','U') + call HDELET(idh+1) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine throwMeyerAngle (theta) +c ================================== + + implicit none + + real lowerbound,y1,y2,f,root,radiant,fraction + integer bin,nBin + integer nBinMax + parameter (nBinMax=201) + + real theta,thetaStep + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + real rhelp + + real random + integer seed + common /seed/ seed + + +c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von +c random erreicht oder ueberschreitet: + + random = ran(seed) + + bin = 1 + do while (random.GT.integ(bin)) + bin = bin + 1 + if (bin.GT.nBin) then + write(*,*) 'error 1' + call exit + endif + enddo + + fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1)) + y1 = value(bin-1) + y2 = value(bin) + f = thetaStep / (y2-y1) + rHelp = y1*f + + radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f + root = SQRT(radiant) + lowerBound = real(bin-1)*thetaStep + if (f.GT.0) then + theta = lowerBound - rHelp + root + else + theta = lowerBound - rHelp - root + endif + + + END + + +c=============================================================================== + + options /extend_source + + subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2) +c ===================================================== + + implicit none + +c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau' +c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den +c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine +c verwendeten Tabellen sind eben dieser Referenz entnommen: +c L.Meyer, phys.stat.sol. (b) 44, 253 (1971) + + real tau,thetaSchlange + real f1, f2, f1_(2), f2_(2) + + integer column_,column,row + + integer iColumn + real weightCol, weightRow + +c------------------------------------------------------------------------------- + +c die Tabellendaten der Referenz (Tabellen 2 und 3): + + integer nColumn + parameter (nColumn = 25) + real tau_(nColumn) / + + 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, + + 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 10., 12., 14., 16., 18., 20. / + + integer nRowA + parameter (nRowA = 25) + real thetaSchlangeA(nRowA) / + + .00, .05, .10, .15, .20, .25, .30, .35, .40, .45, .50, .60, + + .70, .80, .90, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, 3.5, 4.0 / + + integer nRowB + parameter (nRowB = 24) + real thetaSchlangeB(nRowB) / + + 0.0, 0.2, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.5, 1.6, 1.8, + + 2.0, 2.2, 2.4, 2.6, 2.8, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0 / + + integer nRowC + parameter (nRowC = 24) + real thetaSchlangeC(nRowC) / + + 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, + + 7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., 16., 18., 20. / + + + real f1_A(9,nRowA) + + /1.69E+2,4.55E+1,2.11E+1,1.25E+1,8.48E+0,6.21E+0,4.80E+0,3.86E+0,3.20E+0, + + 9.82E+1,3.72E+1,1.97E+1,1.20E+1,8.27E+0,6.11E+0,4.74E+0,3.83E+0,3.17E+0, + + 3.96E+1,2.58E+1,1.65E+1,1.09E+1,7.73E+0,5.82E+0,4.58E+0,3.72E+0,3.10E+0, + + 1.76E+1,1.58E+1,1.27E+1,9.26E+0,6.93E+0,5.38E+0,4.31E+0,3.55E+0,2.99E+0, + + 8.62E+0,1.01E+1,9.45E+0,7.58E+0,6.02E+0,4.85E+0,3.98E+0,3.33E+0,2.84E+0, + + 4.65E+0,6.55E+0,6.91E+0,6.06E+0,5.11E+0,4.28E+0,3.62E+0,3.08E+0,2.66E+0, + + 2.74E+0,4.45E+0,5.03E+0,4.78E+0,4.27E+0,3.72E+0,3.23E+0,2.82E+0,2.47E+0, + + 1.77E+0,3.02E+0,3.71E+0,3.76E+0,3.53E+0,3.20E+0,2.86E+0,2.55E+0,2.27E+0, + + 1.22E+0,2.19E+0,2.78E+0,2.96E+0,2.91E+0,2.73E+0,2.51E+0,2.28E+0,2.07E+0, + + 8.82E-1,1.59E+0,2.12E+0,2.35E+0,2.39E+0,2.32E+0,2.19E+0,2.03E+0,1.87E+0, + + 6.55E-1,1.20E+0,1.64E+0,1.88E+0,1.97E+0,1.96E+0,1.90E+0,1.79E+0,1.68E+0, + + 3.80E-1,7.15E-1,1.01E+0,1.22E+0,1.35E+0,1.40E+0,1.41E+0,1.39E+0,1.34E+0, + + 2.26E-1,4.45E-1,6.44E-1,8.08E-1,9.28E-1,1.01E+0,1.05E+0,1.06E+0,1.05E+0, + + 1.39E-1,2.80E-1,4.21E-1,5.45E-1,6.46E-1,7.22E-1,7.75E-1,8.07E-1,8.21E-1, + + 8.22E-2,1.76E-1,2.78E-1,3.71E-1,4.53E-1,5.21E-1,5.74E-1,6.12E-1,6.37E-1, + + 5.04E-2,1.11E-1,1.86E-1,2.57E-1,3.22E-1,3.79E-1,4.27E-1,4.65E-1,4.94E-1, + + 2.51E-2,5.60E-2,9.24E-2,1.31E-1,1.69E-1,2.02E-1,2.40E-1,2.71E-1,2.97E-1, + + 1.52E-2,3.20E-2,5.08E-2,7.23E-2,9.51E-2,1.18E-1,1.41E-1,1.63E-1,1.83E-1, + + 1.03E-2,2.05E-2,3.22E-2,4.55E-2,6.01E-2,7.53E-2,9.02E-2,1.05E-1,1.19E-1, + + 8.80E-3,1.48E-2,2.25E-2,3.13E-2,4.01E-2,5.03E-2,6.01E-2,7.01E-2,8.01E-2, + + 6.10E-3,1.15E-2,1.71E-2,2.28E-2,2.89E-2,3.52E-2,4.18E-2,4.86E-2,5.55E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,1.71E-2,1.98E-2,2.28E-2,2.58E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.90E-3,1.02E-2,1.16E-2,1.31E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,4.90E-3,5.70E-3,6.40E-3,7.20E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.90E-3,3.40E-3,3.90E-3,4.30E-3/ + + real f1_B(9,nRowB) + + /2.71E+0,1.92E+0,1.46E+0,1.16E+0,9.52E-1,8.03E-1,6.90E-1,5.32E-1,4.28E-1, + + 2.45E+0,1.79E+0,1.39E+0,1.12E+0,9.23E-1,7.82E-1,6.75E-1,5.23E-1,4.23E-1, + + 1.87E+0,1.48E+0,1.20E+0,9.96E-1,8.42E-1,7.24E-1,6.32E-1,4.98E-1,4.07E-1, + + 1.56E+0,1.30E+0,1.09E+0,9.19E-1,7.89E-1,6.86E-1,6.03E-1,4.80E-1,3.95E-1, + + 1.28E+0,1.11E+0,9.62E-1,8.33E-1,7.27E-1,6.40E-1,5.69E-1,4.59E-1,3.81E-1, + + 8.23E-1,7.90E-1,7.29E-1,6.64E-1,6.01E-1,5.44E-1,4.94E-1,4.12E-1,3.49E-1, + + 5.14E-1,5.36E-1,5.29E-1,5.07E-1,4.78E-1,4.47E-1,4.16E-1,3.60E-1,3.13E-1, + + 3.19E-1,3.58E-1,3.76E-1,3.78E-1,3.70E-1,3.57E-1,3.45E-1,3.08E-1,2.76E-1, + + 2.02E-1,2.40E-1,2.64E-1,2.77E-1,2.82E-1,2.80E-1,2.65E-1,2.59E-1,2.39E-1, + + 1.67E-1,1.96E-1,2.20E-1,2.36E-1,2.44E-1,2.47E-1,2.45E-1,2.35E-1,2.21E-1, + + 1.33E-1,1.61E-1,1.85E-1,2.02E-1,2.12E-1,2.18E-1,2.18E-1,2.14E-1,2.03E-1, + + 8.99E-2,1.12E-1,1.32E-1,1.48E-1,1.59E-1,1.67E-1,1.68E-1,1.75E-1,1.72E-1, + + 6.24E-2,7.94E-2,9.50E-2,1.09E-1,1.20E-1,1.29E-1,1.35E-1,1.42E-1,1.43E-1, + + 4.55E-2,5.74E-2,6.98E-2,8.11E-2,9.09E-2,9.92E-2,1.06E-1,1.15E-1,1.19E-1, + + 3.35E-2,4.22E-2,5.19E-2,6.11E-2,6.95E-2,7.69E-2,8.33E-2,9.28E-2,9.85E-2, + + 2.50E-2,3.16E-2,3.92E-2,4.66E-2,5.35E-2,6.00E-2,6.57E-2,7.49E-2,8.13E-2, + + 1.90E-2,2.40E-2,2.99E-2,3.58E-2,4.16E-2,4.70E-2,5.20E-2,6.05E-2,6.70E-2, + + 1.47E-2,1.86E-2,2.32E-2,2.79E-2,3.25E-2,3.70E-2,4.12E-2,4.89E-2,5.51E-2, + + 8.10E-3,1.04E-2,1.30E-2,1.57E-2,1.84E-2,2.12E-2,2.40E-2,2.93E-2,3.42E-2, + + 4.80E-3,6.20E-3,7.70E-3,9.30E-3,1.09E-2,1.26E-2,1.44E-2,1.79E-2,2.14E-2, + + 2.80E-3,3.80E-3,4.70E-3,5.70E-3,6.70E-3,7.50E-3,8.90E-3,1.13E-2,1.36E-2, + + 1.70E-3,2.30E-3,2.90E-3,3.60E-3,4.20E-3,4.90E-3,5.60E-3,7.20E-3,8.80E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.00E-3,2.80E-3,3.50E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.80E-4,1.20E-3,1.60E-3/ + + real f1_C(7,nRowC) + + /3.65E-1,2.62E-1,2.05E-1,1.67E-1,1.41E-1,1.21E-1,1.05E-1, + + 3.33E-1,2.50E-1,1.95E-1,1.61E-1,1.36E-1,1.18E-1,1.03E-1, + + 2.75E-1,2.18E-1,1.76E-1,1.48E-1,1.27E-1,1.11E-1,9.80E-2, + + 2.04E-1,1.75E-1,1.50E-1,1.29E-1,1.13E-1,1.01E-1,9.00E-2, + + 1.41E-1,1.31E-1,1.19E-1,1.08E-1,9.71E-2,8.88E-2,8.01E-2, + + 9.32E-2,9.42E-2,9.10E-2,8.75E-2,8.00E-2,7.44E-2,6.91E-2, + + 5.98E-2,6.52E-2,6.72E-2,6.62E-2,6.40E-2,6.12E-2,5.82E-2, + + 3.83E-2,4.45E-2,4.80E-2,4.96E-2,4.98E-2,4.90E-2,4.77E-2, + + 2.46E-2,3.01E-2,3.40E-2,3.65E-2,3.79E-2,3.84E-2,3.83E-2, + + 1.59E-2,2.03E-2,2.39E-2,2.66E-2,2.85E-2,2.97E-2,3.04E-2, + + 1.04E-2,1.37E-2,1.66E-2,1.92E-2,2.12E-2,2.27E-2,2.37E-2, + + 4.39E-3,6.26E-3,8.26E-3,9.96E-3,1.15E-2,1.29E-2,1.41E-2, + + 2.06E-3,3.02E-3,4.24E-3,5.28E-3,6.32E-3,7.32E-3,8.26E-3, + + 1.21E-3,1.69E-3,2.24E-3,2.85E-3,3.50E-3,4.16E-3,4.82E-3, + + 8.50E-4,1.10E-3,1.38E-3,1.65E-3,2.03E-3,2.45E-3,2.88E-3, + + 5.90E-4,7.40E-4,8.50E-4,9.90E-4,1.23E-3,1.49E-3,1.71E-3, + + 3.90E-4,4.60E-4,5.20E-4,6.30E-4,7.65E-4,9.65E-4,1.12E-3, + + 2.40E-4,2.70E-4,3.10E-4,3.98E-4,4.97E-4,6.03E-4,7.18E-4, + + 1.50E-4,1.70E-4,2.15E-4,2.70E-4,3.35E-4,4.35E-4,5.00E-4, + + 1.00E-4,1.20E-4,1.46E-4,1.90E-4,2.40E-4,2.88E-4,3.43E-4, + + 0.00 ,0.00 ,1.04E-4,1.41E-4,1.80E-4,2.10E-4,2.50E-4, + + 0.00 ,0.00 ,8.20E-5,1.06E-4,1.38E-4,1.58E-4,1.85E-4, + + 0.00 ,0.00 ,5.40E-5,7.00E-5,8.60E-5,1.03E-4,1.20E-4, + + 0.00 ,0.00 ,4.20E-5,5.40E-5,6.50E-5,7.70E-5,8.80E-5/ + + real f2_A(9,nRowA) + + / 3.52E+3, 3.27E+2, 9.08E+1, 3.85E+1, 2.00E+1, 1.18E+1, 7.55E+0, 5.16E+0, 3.71E+0, + + 2.58E+2, 1.63E+2, 7.30E+1, 3.42E+1, 1.85E+1, 1.11E+1, 7.18E+0, 4.96E+0, 3.59E+0, + + -1.12E+2, 4.84E+0, 3.56E+1, 2.34E+1, 1.45E+1, 9.33E+0, 6.37E+0, 4.51E+0, 3.32E+0, + + -5.60E+1,-1.12E+1, 9.87E+0, 1.24E+1, 9.59E+0, 7.01E+0, 5.16E+0, 3.83E+0, 2.91E+0, + + -2.13E+1,-1.22E+1,-2.23E+0, 3.88E+0, 5.15E+0, 4.65E+0, 3.87E+0, 3.12E+0, 2.45E+0, + + -8.25E+0,-9.58E+0,-5.59E+0,-1.40E+0, 1.76E+0, 2.71E+0, 2.71E+0, 2.35E+0, 1.95E+0, + + -3.22E+0,-6.12E+0,-5.28E+0,-2.87E+0,-1.92E-1, 1.32E+0, 1.69E+0, 1.74E+0, 1.48E+0, + + -1.11E+0,-3.40E+0,-4.12E+0,-3.08E+0,-6.30E-1, 3.60E-1, 9.20E-1, 1.03E+0, 1.04E+0, + + -2.27E-1,-2.00E+0,-2.93E+0,-2.69E+0,-1.48E+0,-3.14E-1, 2.69E-1, 5.28E-1, 6.09E-1, + + 1.54E-1,-1.09E+0,-2.10E+0,-2.15E+0,-1.47E+0,-6.77E-1,-1.80E-1, 1.08E-1, 2.70E-1, + + 3.28E-1,-6.30E-1,-1.50E+0,-1.68E+0,-1.34E+0,-8.43E-1,-4.60E-1,-1.85E-1,-4.67E-3, + + 3.32E-1,-2.06E-1,-7.32E-1,-9.90E-1,-9.42E-1,-8.20E-1,-6.06E-1,-4.51E-1,-3.01E-1, + + 2.72E-1,-3.34E-2,-3.49E-1,-5.65E-1,-6.03E-1,-5.79E-1,-5.05E-1,-4.31E-1,-3.45E-1, + + 2.02E-1, 2.80E-2,-1.54E-1,-3.00E-1,-3.59E-1,-3.76E-1,-4.60E-1,-3.40E-1,-3.08E-1, + + 1.38E-1, 4.84E-2,-5.56E-2,-1.44E-1,-2.04E-1,-2.39E-1,-2.54E-1,-2.49E-1,-2.48E-1, + + 9.47E-2, 4.86E-2,-1.08E-2,-6.44E-2,-1.02E-1,-1.34E-1,-1.62E-1,-1.79E-1,-1.87E-1, + + 5.33E-2, 3.71E-2, 1.85E-2, 1.63E-3,-1.69E-2,-3.69E-2,-5.66E-2,-7.78E-2,-9.33E-2, + + 3.38E-2, 2.40E-2, 1.62E-2, 9.90E-3, 3.76E-3,-4.93E-3,-1.66E-2,-3.05E-2,-4.22E-2, + + 2.12E-2, 1.56E-2, 1.05E-2, 7.80E-3, 7.92E-3, 6.30E-3, 3.20E-4,-8.50E-3,-1.66E-2, + + 1.40E-2, 9.20E-3, 5.30E-3, 4.70E-3, 6.31E-3, 8.40E-3, 5.30E-3, 8.80E-4,-3.30E-3, + + 9.20E-3, 4.70E-3, 1.70E-3, 2.60E-3, 4.49E-3, 6.60E-3, 6.00E-3, 4.70E-3, 2.80E-3, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + real f2_B(9,nRowB) + + / 2.75E+0, 1.94E+0, 9.13E-1, 6.06E-1, 4.26E-1, 3.14E-1, 2.40E-1, 1.51E-1, 1.03E-1, + + 1.94E+0, 1.16E+0, 7.56E-1, 5.26E-1, 3.81E-1, 2.87E-1, 2.23E-1, 1.43E-1, 9.78E-2, + + 5.85E-1, 5.04E-1, 4.10E-1, 3.30E-1, 2.69E-1, 2.17E-1, 1.78E-1, 1.22E-1, 8.71E-2, + + 7.83E-2, 2.00E-1, 2.35E-1, 2.19E-1, 1.97E-1, 1.73E-1, 1.48E-1, 1.08E-1, 7.93E-2, + + -1.82E-1, 1.56E-2, 1.04E-1, 1.36E-1, 1.38E-1, 1.31E-1, 1.19E-1, 9.46E-2, 7.19E-2, + + -2.71E-1,-1.66E-1,-7.29E-2,-4.74E-3, 3.60E-2, 5.50E-2, 6.28E-2, 5.98E-2, 5.09E-2, + + -1.87E-1,-1.58E-1,-1.09E-1,-5.80E-2,-2.03E-2, 2.48E-3, 1.99E-2, 3.36E-2, 3.27E-2, + + -1.01E-1,-1.05E-1,-8.95E-2,-6.63E-2,-3.93E-2,-2.38E-2,-9.22E-3, 8.47E-3, 1.52E-2, + + -5.19E-2,-6.47E-2,-6.51E-2,-5.62E-2,-4.51E-2,-3.49E-2,-2.45E-2,-8.19E-3, 2.05E-3, + + -3.68E-2,-4.89E-2,-5.36E-2,-5.06E-2,-4.27E-2,-3.65E-2,-2.80E-2,-1.33E-2,-3.47E-3, + + -2.33E-2,-3.69E-2,-4.41E-2,-4.38E-2,-3.97E-2,-3.50E-2,-2.88E-2,-1.60E-2,-6.68E-3, + + -8.76E-3,-2.07E-2,-2.90E-2,-3.17E-2,-3.09E-2,-2.92E-2,-2.63E-2,-1.79E-2,-1.03E-2, + + -1.20E-3,-1.11E-2,-1.90E-2,-2.20E-2,-2.32E-2,-2.24E-2,-2.10E-2,-1.66E-2,-1.11E-2, + + 1.72E-3,-4.82E-3,-1.02E-2,-1.42E-2,-1.65E-2,-1.66E-2,-1.60E-2,-1.39E-2,-1.09E-2, + + 2.68E-3,-1.18E-3,-5.19E-3,-8.30E-5,-1.01E-2,-1.14E-2,-1.16E-2,-1.16E-2,-9.99E-3, + + 2.81E-3, 8.21E-4,-1.96E-3,-3.99E-3,-5.89E-3,-7.13E-3,-8.15E-3,-9.05E-3,-8.60E-3, + + 2.61E-3, 1.35E-3,-2.99E-4,-1.79E-3,-3.12E-3,-4.44E-3,-5.61E-3,-7.01E-3,-7.27E-3, + + 2.06E-3, 1.45E-3, 4.64E-4,-5.97E-4,-1.71E-3,-2.79E-3,-3.84E-3,-5.29E-3,-5.90E-3, + + 1.07E-3, 9.39E-4, 8.22E-4, 3.58E-4,-1.15E-4,-6.60E-4,-1.18E-3,-2.15E-3,-2.88E-3, + + 4.97E-4, 5.46E-4, 6.15E-4, 5.56E-4, 3.14E-4, 9.80E-5,-1.30E-4,-5.98E-4,-1.07E-4, + + 1.85E-4, 3.11E-4, 4.25E-4, 4.08E-4, 3.63E-4, 3.04E-4, 2.24E-4, 2.80E-5,-2.10E-4, + + 4.80E-5, 1.48E-4, 2.44E-4, 2.80E-4, 3.01E-4, 3.11E-4, 3.13E-4, 2.40E-4, 1.10E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 1.39E-4, 1.80E-4, 1.80E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 4.38E-5, 7.30E-5, 8.40E-5/ + + real f2_C(7,nRowC) + + / 7.36E-2, 4.21E-2, 2.69E-2, 1.83E-2, 1.34E-2, 1.01E-2, 7.88E-3, + + 5.79E-2, 3.61E-2, 2.34E-2, 1.64E-2, 1.21E-2, 9.26E-3, 7.28E-3, + + 2.94E-2, 2.17E-2, 1.60E-2, 1.23E-2, 9.49E-3, 7.45E-3, 5.95E-3, + + 2.30E-3, 7.07E-3, 7.76E-3, 7.02E-3, 6.13E-3, 5.17E-3, 4.34E-3, + + -7.50E-3,-2.00E-3, 9.93E-4, 2.36E-3, 2.82E-3, 2.86E-3, 2.72E-3, + + -8.27E-3,-5.37E-3,-2.58E-3,-7.96E-4, 3.75E-4, 9.71E-4, 1.28E-3, + + -5.79E-3,-5.12E-3,-3.86E-3,-2.46E-3,-1.20E-3,-3.74E-4, 1.74E-4, + + -3.26E-3,-3.43E-3,-3.26E-3,-2.68E-3,-1.84E-3,-1.12E-3,-4.54E-4, + + -1.46E-3,-1.49E-3,-2.20E-3,-2.18E-3,-1.85E-3,-1.40E-3,-8.15E-4, + + -4.29E-4,-9.44E-4,-1.29E-3,-1.50E-3,-1.51E-3,-1.36E-3,-9.57E-4, + + -3.30E-5,-3.66E-4,-6.78E-4,-9.38E-4,-1.09E-3,-1.09E-3,-9.56E-4, + + 1.50E-4, 3.10E-5,-1.38E-4,-3.06E-4,-4.67E-4,-5.48E-4,-6.08E-4, + + 1.00E-4, 8.50E-5, 2.30E-5,-6.60E-5,-1.58E-4,-2.40E-4,-3.05E-4, + + 5.40E-5, 6.50E-5, 4.90E-5, 1.20E-5,-3.60E-5,-8.90E-5,-1.31E-4, + + 2.90E-5, 4.30E-5, 4.40E-5, 2.90E-5, 5.10E-6,-2.20E-5,-4.80E-5, + + 1.40E-5, 2.40E-5, 2.80E-5, 2.60E-5, 1.90E-5, 7.50E-6,-1.10E-5, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + +c=============================================================================== + +c Bestimme, welche Reihen der Tabellen fuer Interpolation benoetigt werden: + + if (tau.LT.tau_(1)) then + write(*,*) 'tau is less than the lowest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'minimum = ',tau_(1) + call exit + elseif (tau.GT.tau_(nColumn)) then + write(*,*) 'tau is greater than the highest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'maximum = ',tau_(nColumn) + call exit + endif + + column_ = 2 + do while (tau.GT.tau_(column_)) + column_ = column_ + 1 + enddo + ! Das Gewicht der Reihe zu groesserem Tau: + weightCol = (tau-tau_(column_-1)) / (tau_(column_)-tau_(column_-1)) + + +c Besorge fuer gegebenes 'thetaSchlange' die interpolierten f1- und f2 -Werte +c der beiden relevanten Reihen: +c iColumn = 1 => Reihe mit hoeherem Index +c iColumn = 2 => Reihe mit kleinerem Index + + + iColumn = 1 + + +5 continue + + if (column_.LE.9) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8 + + column = column_ + + if (thetaSchlange.LT.thetaSchlangeA(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeA(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeA(nRowA)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeA(nRowA) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeA(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeA(row-1)) / + + (thetaSchlangeA(row)-thetaSchlangeA(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_A(column,row-1) + + + weightRow * f1_A(column,row) + f2_(iColumn) = (1.-weightRow) * f2_A(column,row-1) + + + weightRow * f2_A(column,row) + + + elseif (column_.LE.18) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 2. Tabelle: 2.0 <= tau <= 7.0 + + column = column_ - 9 + + if (thetaSchlange.LT.thetaSchlangeB(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeB(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeB(nRowB)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeB(nRowB) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeB(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeB(row-1)) / + + (thetaSchlangeB(row)-thetaSchlangeB(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_B(column,row-1) + + + weightRow * f1_B(column,row) + f2_(iColumn) = (1.-weightRow) * f2_B(column,row-1) + + + weightRow * f2_B(column,row) + + + else ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 3. Tabelle: 8.0 <= tau <= 20. + + column = column_ - 18 + + if (thetaSchlange.LT.thetaSchlangeC(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeC(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeC(nRowC)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeC(nRowC) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeC(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeC(row-1)) / + + (thetaSchlangeC(row)-thetaSchlangeC(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_C(column,row-1) + + + weightRow * f1_C(column,row) + f2_(iColumn) = (1.-weightRow) * f2_C(column,row-1) + + + weightRow * f2_C(column,row) + + + endif ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + + if (iColumn.EQ.1) then + column_ = column_ - 1 + iColumn = 2 + goto 5 + endif + + f1 = weightCol*f1_(1) + (1.-weightCol)*f1_(2) + f2 = weightCol*f2_(1) + (1.-weightCol)*f2_(2) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE reset_statistics +c =========================== + + IMPLICIT NONE + + integer Nr,n,k + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c der allgemeine Statistikspeicher: (*) : braucht nicht resettet zu werden +c --------------------------------- +c +c statMem(1,Nr): 1. Wert: x(1) (*) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ergebnis-Statistik-Speicher resetten: + + do Nr = 1, stat_Anzahl + statMem(2,Nr) = 0. ! Summe der Werte + statMem(3,Nr) = 0. ! Summe der Quadrate + statMem(4,Nr) = 1.e10 ! Minimalwert + statMem(5,Nr) = -1.e10 ! Maximalwert + statMem(8,Nr) = 0. ! Anzahl + enddo + +c die Scaler fuer den Returncode des TDs und die Pfostenhits sowie die +c StartZaehler resetten: + + do n = 1, 2 ! (1: Projektile, 2: FolienElektronen) + start_nr(n) = 0 + do k = 1, 18 + statTD(n,k) = 0. + enddo + do k = 1, 75 + pfostenHit(k,n) = 0. + enddo + enddo + + +c der Statistikspeicher fuer das Teilchen-Schicksal: + + do k = smallest_code_Nr, Gebiete_Anzahl*highest_code_Nr + statDestiny(k) = 0 + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE fill_statMem(wert,Nr) +c ================================ + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real wert + integer Nr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Wird die Varianz der Verteilung einer Groesse x gemaess der Formel +c +c Var(x) = SQRT( - **2 ) , < > -> Erwartungswert +c +c mit +c = 1/n * Summe_ueber_i( x(i) ) +c = 1/n * Summe_ueber_i( x(i)**2 ) +c +c berechnet, so tritt manchmal aufgrund der beschraenkten Genauigkeit der +c numerischen Speicher das Problem auf, dass bei grossen Werten x(i) und +c kleiner Streuung der Ausdruck unter der Wurzel negativ wird, was erstens +c unphysikalisch ist und zweitens zum Programmabbruch fuehrt. +c +c Dieses Problem liesse sich vermeiden, wenn man die Groessen x(i) relativ +c zu ihrem Erwartungswert angeben wuerde, der aber erst im nachhinein bekannt +c ist. +c +c Als Naeherungsloesung verwende ich daher fuer die Berechnung der Varianz die +c x(i) relativ zu x(1), also zum ersten Wert gemessen, der gerade bei kleiner +c Streuung, bei der das numerische Problem auftritt, nahe am Erwartungswert +c liegen sollte. +c +c statMem(1,Nr): 1. Wert: x(1) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c +c (*): wird im SUB 'eval_statistics' berechnet. +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Zaehle mit: + + statMem(8,Nr) = statMem(8,Nr) + 1. + + +c Speichere den ersten Wert: + + if (statMem(8,Nr).EQ.1) statMem(1,Nr) = wert + + +c Summiere die Abweichungen vom ersten Wert: + + statMem(2,Nr) = statMem(2,Nr) + (wert-statMem(1,Nr)) + + +c Summiere die Quadratischen Abweichungen vom ersten Wert: + + statMem(3,Nr) = statMem(3,Nr) + (wert-statMem(1,Nr))**2. + + +c Speichere den kleinsten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(4,Nr) = 1.e10): + + if (statMem(4,Nr).GT.wert) statMem(4,Nr) = wert + + +c Speichere den groessten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(5,Nr) = -1.e10): + + if (statMem(5,Nr).LT.wert) statMem(5,Nr) = wert + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE eval_statistics +c ========================== + + IMPLICIT NONE + +c statMem(1,Nr): 1. Wert: x(1) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert +c statMem(7,Nr): Varianz +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' +c ('StartsProSchleife' == n_par(0)) + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real n ! Anzahl der Werte, == statMem(8,Nr) + real radiant + + integer Nr,l + + + do Nr = 1, Stat_Anzahl + if (statNeeded(Nr)) then + n = statMem(8,Nr) + if (n.ne.0.) then + + !c Berechne Mittelwert: + statMem(6,Nr) = statMem(2,Nr)/n + statMem(1,Nr) + + !c Berechne Varianz: + radiant = ( statMem(3,Nr) - (statMem(2,Nr)**2. )/n)/n + statMem(7,Nr) = sqrt(radiant) + + !c Berechne Anteil an allen gestarteten in Prozent + statMem(9,Nr) = 100.*n/real(n_par(0)) + + else + + do l = 1, 9 + statMem(l,Nr) = 0. + enddo + + endif + endif + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SAVE_GRAPHICS_KOORD +c ============================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000) ! Koordinatenfelder fuer die + real yKoord(1000) ! Graphikausgabe + real zKoord(1000) ! +cMBc real tKoord(1000) ! + integer nKoord ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord ! fuer Graphikaufruf + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord ! fuer Graphikaufruf + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + nKoord = nKoord + 1 + + xKoord(nKoord) = x(1) + yKoord(nKoord) = x(2) + zKoord(nKoord) = x(3) +cMBc tKoord(nKoord) = t + + if (nKoord.EQ.1000) then + if (Gebiet.LE.upToChKoord) then ! Bahnberechnung wurde vor + call plot_horizontal ! Koordinatenwechsel abgebrochen + else + call plot_vertikal + endif + xKoord(1) = xKoord( 999) ! die letzten beiden uebernehmen, + yKoord(1) = yKoord( 999) ! damit gegebenenfalls der Richtungs- + zKoord(1) = zKoord( 999) ! pfeil gezeichnet werden kann. +cMBc tKoord(1) = tKoord( 999) + xKoord(2) = xKoord(1000) + yKoord(2) = yKoord(1000) + zKoord(2) = zKoord(1000) +cMBc tKoord(2) = tKoord(1000) + nKoord = 2 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Output_Debug +c ======================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + real Ekin, temp1, temp2 + + Ekin = (v(1)*v(1) + v(2)*v(2) + v(3)*v(3)) * Energie_Faktor + + if (Gebiet.EQ.1 .AND. alfaTgt.NE.0) then + if (alfaTgtVertically) then + temp1 = xGrid1*Cos_alfaTgt - x(3)*Sin_alfaTgt + temp2 = xGrid1*Sin_alfaTgt + x(3)*Cos_alfaTgt + write(lun(1),1) steps,Gebiet,t,temp1,x(2),temp2,v,Ekin + else + temp1 = xGrid1*Cos_alfaTgt - x(2)*Sin_alfaTgt + temp2 = xGrid1*Sin_alfaTgt + x(2)*Cos_alfaTgt + write(lun(1),1) steps,Gebiet,t,temp1,temp2,x(3),v,Ekin + endif + else + write(lun(1),1) steps,Gebiet,t,x,v,Ekin + endif + +1 format(X,I4,X,I2,4X,F6.1,2X,F7.2,X,F6.2,X,F6.2,2X,F6.2,X, + + F6.2,X,F6.2,2X,G13.6) + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Decay_Test(*) +c ======================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real dt + + if (t.GT.lifeTime) then ! Teilchen zerfallen + dt = t - lifeTime + t = lifeTime + x(1) = x(1) - dt*v(1) + x(2) = x(2) - dt*v(2) + x(3) = x(3) - dt*v(3) + destiny = code_decay + RETURN 1 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE chargeStateYields(E,masse,Yield_plus,Yield_zero) +c =========================================================== + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Die Funktion sowie die Parameter sind uebernommen aus: +c +c M.Gonin, R.Kallenbach, P.Bochsler: 'Charge exchange of hydrogen atoms +c in carbon foils at 0.4 - 120 keV', Rev.Sci.Instrum. 65 (3), March 1994 +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + IMPLICIT NONE + + real E ! kinetische Energie in keV + real masse ! in keV / c**2 + + real a_zero,a_minus + real k_Fermi,k_zero,k_minus + real zwo_k_Fermi + real k_Fermi_Quad,k_zero_Quad,k_minus_Quad + real vc_minus,vc_plus,v_Bohr,v_rel + + parameter ( a_zero = 0.953, a_minus = 0.029 ) + parameter ( k_Fermi = 1.178 ) ! [v_Bohr] + parameter ( k_Fermi_Quad = k_Fermi * k_Fermi ) + parameter ( zwo_k_fermi = 2. * k_Fermi ) + parameter ( k_zero = 0.991*k_Fermi ) ! [v_Bohr] + parameter ( k_zero_Quad = k_zero * k_zero ) + parameter ( k_minus = 0.989*k_Fermi ) ! [v_Bohr] + parameter ( k_minus_Quad = k_minus * k_minus ) + parameter ( vc_minus = 0.284, vc_plus = 0.193 ) ! [v_Bohr] + parameter ( v_Bohr = 7.2974E-3 ) ! [c] + + real Q_zero,Q_minus,D + real Yield_minus,Yield_zero,Yield_plus + + real help1,help2,help3 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (E.LT.0) then + write(*,*) + write(*,*) 'error in subroutine ''chargeStateYields'':' + write(*,*) 'E = ',E,' < 0!' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c Energie in Geschwindigkeit umrechnen (in Einheiten von v_Bohr): + +c - klassisch: + + v_rel = SQRT(2.*E/masse) / v_Bohr + +c - relativistisch: + +c help1 = 1. + E/masse +c v_rel = SQRT(1. - 1./(help1*help1)) / v_Bohr + + +c Die geladenen Anteile berechnen (vgl. obige Referenz): + + help1 = v_rel*v_rel + help2 = zwo_k_Fermi*v_rel + Q_zero = 1. + (k_zero_Quad - k_Fermi_Quad - help1) / help2 + Q_minus = 1. + (k_minus_Quad - k_Fermi_Quad - help1) / help2 + + + help1 = a_zero * Q_zero + help2 = a_minus * Q_minus + help3 = (1.-Q_zero)*(1.-Q_minus) + D = help1*(help2 + (1.-Q_minus)) + help3 + + Yield_minus = help1*help2 / D + Yield_plus = help3 / D + + Yield_minus = Yield_minus * exp(-vc_minus/v_rel) + Yield_plus = Yield_plus * exp(-vc_plus /v_rel) + + Yield_zero = 1. - (Yield_minus + Yield_plus) + +c write(6,*) 'E vrel Neutral Plus Minus' +c write(6,*) E, v_rel, yield_zero, yield_plus, yield_minus + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE test_wireHit(distToWire,WireRadiusQuad,v_x,v_y,WireHit) +c ================================================================== + +c Diese Routine ueberprueft, ob bei gegebenem Abstandsvektor 'distToWire' +c zwischen Teilchen und Draht und gegebener Geschwindigkeit v eines Teilchens +c bei geradliniger Bewegung und Drahtradius 'WireRadius' ein Schnittpunkt +c von Teilchenbahn und Drahtumfang existiert, ob also der Draht getroffen wird. +c Dafuer genuegt es zu pruefen, ob der Radiant der 'Mitternachtsformel' fuer die +c entsprechende quadratische Gleichung groesser oder gleich Null ist: + + IMPLICIT NONE + + real DistToWire(2),WireRadiusQuad,v_x,v_y + logical WireHit + + real steigung, help, radiant + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (abs(v_x).GT.abs(v_y)) then + steigung = v_y/v_x + help = distToWire(2) - distToWire(1) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + else + steigung = v_x/v_y + help = distToWire(1) - distToWire(2) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + endif + + if (radiant.ge.0) then + wireHit = .true. + else + wireHit = .false. + endif + + + END + + +c=============================================================================== diff --git a/mutrack/src/MUTRACK_OLD.FOR b/mutrack/src/MUTRACK_OLD.FOR new file mode 100644 index 0000000..d98c663 --- /dev/null +++ b/mutrack/src/MUTRACK_OLD.FOR @@ -0,0 +1,5400 @@ +c****************************************************************************** +c* ... MUTRACK.FOR (Stand: Februar '96) * +c* * +c* Dieses Programm integriert Teilchenbahnen in der UHV-Kammer der NEMU- * +c* Apparatur. Startpunkte koennen zwischen der Moderatorfolie und dem MCP2 * +c* frei gewaehlt werden, Endpunkt der Berechnungen ist (sofern die Teilchen * +c* nicht vorher schon ausscheiden) die Ebene des MCP2. Bis jetzt koennen * +c* also nur Bewegungen in Strahlrichtung, nicht entgegen derselben berechnet * +c* werden. * +c* Das Programm selbst rechnet den zweistufigen Beschleuniger als ideal, * +c* bietet aber die Moeglichkeit Simulationen von TP oder AH (Programm 'Accel')* +c* mit realem Beschleuniger einzulesen. Die Integration der Teilchenbahnen * +c* erstreckt sich bei diesen Simulationen bis etwa zum He-Schild, MUTRACK * +c* rechnet dann von dort aus weiter. * +c* Verschiedene Einstellungen koennen in ineinandergreifenden Schleifen in * +c* aequidistanten Schritten variiert werden (z.B. Spannungen des Transport- * +c* Systems, Startgroessen der Teilchen, Masse und Ladung ...). Ein Teil dieser* +c* Groessen kann aber auch alternativ nach verschiedenen frei waehlbaren * +c* Zufallsverteilungen gewurfelt werden. * +c* Die Integrationsergebnisse koennen in der Form von NTupeln abgespeichert * +c* werden, was sie der Darstellung und Auswertung mit dem CERN-Programm PAW * +c* zugaenglich macht. * +c* Neben der reinen Integrationsarbeit fuehrt Mutrack Statistiken ueber * +c* verschiedene Groessen (z.Z. verschiedene Flugzeiten und Ortsverteilungen) * +c* die Mittelwerte und Standandartabweichungen sowie Minimal- und Maximalwerte* +c* umfassen. * +c* Diese Groessen koennen einfach ausgegeben oder in einem Tabellenfile abge- * +c* speichert werden, welches von PHYSICA mittels der Fortran-Routine * +c* 'READ_DATA' eingelesen werden kann. Verschiedene PHYSICA-Makros * +c* (.PCM-files) ermoeglichen dann die Darstellung dieser statistischen * +c* Groessen in Form von 2D- und 3D-Graphiken. (z.B. Abhaengigkeit der Trans- * +c* mission von HV-Settings des Transportsystems). * +c* Die momentan vorhandenen Routinen heissen * +c* * +c* MUINIT.PCM * +c* HELP.PCM * +c* MUPLOT_1DIM.PCM * +c* MUPLOT_2DIM.PCM * +c* TYPE_LOGHEADER.PCM * +c* TYPE_PARAMS_GRAPHIC.PCM * +c* TYPE_PARAMS_TEXT.PCM * +c* * +c* Nach dem Start (von dem Directory aus, in dem obige Routinen abgelegt sind)* +c* muss PHYSICA mit dem Befehl '@MUINIT' initialisiert werden. Danach koennen * +c* obige Routinen ueber Aliasse angesprochen werden. Weitere Informationen * +c* hierzu erhaelt man, indem man in PHYSICA nach der Initialisierung 'MUHELP' * +c* eingibt. * +c* Der Sourcecode fuer Mutrack ist ueber verschiedene .FOR-Dateien verteilt, * +c* die jeweils zu einem Problembereich gehoerige Subroutinen enthalten. Die * +c* zur Zeit vorhandenen Files und die darin enthaltenen Routinen sind: +c* +c* MUTRACK.FOR +c* SUB_ARTLIST.FOR +c* SUB_OUTPUT.FOR +c* SUB_INPUT.FOR +c* SUB_INTEGR_FO.FOR +c* SUB_INTEGR_L1.FOR +c* SUB_INTEGR_L3.FOR +c* SUB_INTEGR_M2.FOR +c* SUB_PICTURE.FOR +c* SUB_TRIGGER.FOR +c* +c* +c* Includefiles mit COMMON-Blöcken: +c* +c* COM_DIRS.INC +c* COM_KAMMER.INC +c* COM_LUNS.INC +c* COM_MUTRACK.INC +c* COM_OUTPUT.INC +c* COM_TD_EXT.INC +c* COM_TD_INT.INC +c* COM_WINKEL.INC +c* GEO_KAMMER.INPUT +c* GEO_TRIGGER.INC +c* +c* +c* Icludefile mit Defaultwerten fuer eine Reihe benutzerdefinierbarer und Programm- +c* interner Groessen: +c* +c* INITIALIZE.INC +c* +c* +c* Includefiles fuer die Potentialmappen: +c* +c* MAP_DEF_FO.INC +c* MAP_DEF_L1.INC +c* MAP_DEF_L3.INC +c* MAP_DEF_M2.INC +c* +c* READ_MAP.INC +c* +c* +c* Benoetigte Eingabfiles: +c* +c* MUTRACK.INPUT (fuer die Integrationen zu verwendende Einstellungen) +c* kammer_geo.INPUT (Spezifizierung der Kammergeometrie) +c* mappenName.INFO (Dateien mit Angaben ueber zugehoerige Potentialmappen) +c* mappenName.MAPPE (die Potentialmappen) +c* MUTRACK_NR.DAT (zuletzt vergebene Nummern der Ausgabedateien, wird +c* von Mutrack verwaltet). +c* +c* +c* Fuer die Erstellung der Potentialmappen mit dem Triumf-Programm stehen folgende +c* Hilfsmittel zur Verfuegung: +c* +c* BESCHL-INIT.FOR +c* LENSE-INIT.FOR +c* +c* Diese Boundary-Routinen stellen folgende Moeglichkeiten zur Verfuegung: +c* +c* Initialisierung von Scratch, von 2D und von 3D-Mappen. Kontrollmoeglichkeiten +c* ueber die Ausgabe der Potentialbereiche. +c* +c* Die Mappen koennen von PHYSICA aus mittels der FORTRAN-Routine ' ' +c* und den .PCM-Makros ' ' ... angeschaut und ausgegeben werden. +c* +c* +c* +c* Liste der moeglichen Ausgabefiles: +c* +c* MU_nnnn.LOG +c* MU_nnnn.GEO +c* MU_nnnn.PHYSICA +c* MU_nnnn.NTP +c* MU_nnnn._tab +c* +c* Diese Version von MUTRACK enthaelt nur noch rudimentaere Anteile des ursprueng- +c* lichen Programmes von Thomas Wutzke. Hauptunterschiede und Erweiterungen sind: +c* +c* # Ersetzen der Euler-Integration durch ein schrittweitenkontrolliertes +c* Runge-Kutta Verfahren. Der dieser Implementation zugrundeliegende Algo- +c* rythmus entstammt dabei dem Buch 'NUMERICAL RECIPES, The Art of Scientific +c* Computing' (Fortran Version) von Press, Flannery, Teukolsky und Vetterling, +c* Cambridge University Press (1989). +c* +c* # Verbesserter Algorythmus zur Berechnung der Feldstaerken aus den Potential- +c* Mappen. +c* +c* # Implementierung des gesamten Statistikaparates. (Zuvor waren PAW-Ntupel die +c* einzige Ausgabeform abgesehen von den Debuginformationen). +c* +c* # Uebersichtlichere Gestalltung der Ein- und Ausgabe, sowie der Debug-Infos. +c* +c* # Implementierung der Moeglichkeit, verschiedenen Parameter in Schleifen zu +c* durchlaufen. +c* +c* # Implementierung der fuer die graphische Darstellung mit PHYSICA notwendigen +c* Routinen. +c* +c* # Implementierung des Triggerdetektors. +c* +c* # Implementierung der Graphikausgabe der Teilchenbahnen (diese Routinen wurden +c* in ihrer ersten Fassung von Michael Birke geschrieben). +c* +c* # Umstellen der Potentialmappen auf 'unformattiert' und Einschraenken der +c* Mappen auf den wirklich benoetigten Bereich (d.h. z.B. Ausnutzen der +c* Symmetrie der Linsen, wodurch die Mappengroesse bei den Linsen mehr als +c* halbiert werden konnte. +c* +c* # Implementierung der Moeglichkeit, die Kammergeometrie (d.h. die Positionen +c* der verwendeten Elemente) sowie die Potentialmappen (z.B. fuer unter- +c* schiedliche Linsenkonfigurationen) ueber ein .INPUT-Eingabefile ohne +c* Umschreiben des Sourcecodes aendern zu koennen. +c* +c* Das Programm verwendet fuer Graphikdarstellung und NTupel-Erzeugung Routinen der +c* zum PAW-Komplex gehoerenden CERN-Bibliotheken 'HPLOT' und 'HBOOK'. +c* +c* Am Anfang der Deatei 'COM_MUTRACK.INC' findet sich eine Liste der wichtigsten +c* Aenderungen ueber die verschiedenen Versionen ab 1.4.1. +c* +c* Gruss, Anselm Hofer +c****************************************************************************** + + OPTIONS /EXTEND_SOURCE + +C =============== + program MUTRACK +C =============== + +c Deklarationen: + + Implicit None + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_TD_EXT.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + +c die SCHLEIFENVARIABLEN fuer die 'do 200 ...'-Schleifenund und damit +c zusammenhaengendes (Common-Bloecke werden fuer die NTupel-Ausgabe benoetigt): + +c - 'virtuelle' Flugstreckenverlaengerungen: + + real delta_L1,delta_L2 + +c - Energieverlust in der Triggerfolie und Dicke derselben: + + real E_loss + +c - Drehwinkel: +c (alfaTgt, alfaSp, alfaTD und ihre Winkelfunktionen werden in 'COM_WINKEL.INC' +c erledigt: COMMON /ANGELS/) + + real y_intersectSP ! Benoetigt fuer Schnittpkt. der Trajektorie + real yUppLeft, yLowLeft ! mit forderer Spiegelebene + + real x_intersectTD ! Benoetigt fuer Schnittpkt. der Trajektorie + ! mit TD-Folie + real x_intersectTDMap ! ... mit TD-Mappe + common /x_intersectTD/ x_intersectTD,x_intersectTDMap + +c - Masse und Ladung: + + real m, m_ ! Masse, Laufvariable fuer Massen-Schleife + real q, q_ ! Ladung, Laufvariable fuer Ladungs-Schleife + integer qInt + COMMON /charge/ qInt ! fuer 'NTP_charge' + + integer nNeutral,nCharged ! fuer Ausgabe des gewuerfelten neutralen anteils + COMMON /nNeutral/ nNeutral,nCharged + +c - MCP2: + + real U_MCP2 ! Spannung am MCP2 + + +c - Triggerdetektor: U_F, U_V, U_H und U_MCP3 werden in 'COM_TD_EXT.INC' +c erledigt. (COMMON /TRIGGERSETTINGS/) + +c - Transportsystem: + + real U_Tgt ! Target-Spannung + real U_Gua ! Spannung am Guardring + real U_G1 ! Spannung am ersten Gitter + real U_L1 ! Spannung an Linse 1 + real U_Sp ! Spiegelspannung + real U_L2 ! Spannung an Linse 2 + real U_L3 ! Spannung an Linse 3 + + COMMON /U_L2/ U_L2 ! fuer die Addition der 'L2andFo'-Mappe + + real last_U_L2 / -1.E10 / ! fuer die Addition der 'L2andFo'-Mappe + real last_U_F / -1.E10 / + +c - Magnetfeldstaerken: + + real B_Helm ! Magnetfeld der Helmholtzspulen + real B_TD ! Magnetfeld der Kompensationsspule am TD + +c - Startparameter: + + integer randomloop_ ! Laufvariable fuer zufallsverteilte Starts + real E0_ ! Laufvariable fuer Startenergie_Schleife + real theta0_ ! Laufvarialbe fuer Startwinkel-Schleife + real Sin_theta0, Cos_theta0 ! Startwinkel gegen x-Achse + real phi0_ ! Laufvariable fuer Startwinkel-Schleife + real Sin_phi0, Cos_phi0 ! azimuthaler Startwinkel (phi0=0: y-Achse) + real y0_ ! Laufvariable fuer Startpositions_Schleife + real z0_ ! Laufvariable fuer Startpositions_Schleife + real r0 ! Radius beim Wuerfeln der Startposition + real phi_r0 ! Winkel beim Wuerfeln der Startposition + + ! x0(3),v0(3),E0,theta0,phi0 werden in 'COM_MUTRACK.INC' declariert + + +c allgemeine Trajektoriengroessen + + real dt ! zeitl. Aenderung + real v_xy ! Geschwindigkeit in x/y-Ebene + real v_square, v0_Betrag, v_Betrag + real Ekin ! kinetische Energie + real a1,a2 ! Beschleunigung in 1. bzw. 2. Beschl.Stufe + real aFoil ! Beschleunigung zwischen Massegitter und Folie + real radiusQuad ! RadiusQuadrat + real radiusQuad_ ! RadiusQuadrat + real radius + + real S1xM2 ! Zeit vom Start bis zur MCP2-Ebene + real S1M2 ! Zeit vom Start bis zum MCP2 (Treffer voarausgesetzt) + real S1Fo ! Zeit vom Start bis zur Folie + real S1FoOnly ! Zeit vom Start bis zur Folie + real FoM2 ! Zeit zwischen Folie und MCP2 + real FoM2Only ! wie FoM2, falls keine anderen TOFs verlangt + real S1M3 ! Zeit vom Start bis Eintreffen der FE auf MCP3 + real M3M2 ! Zeit vom Eintreffen der FE auf MCP3 bis MCP2 + + real alfa ! Bahnwinkel gegen die Triggerfolienebene + real E_Verlust /0./ ! Energieverlust in der Folie + real delta_E_Verlust ! Streuung des Energieverlustes in der Folie + real thetaAufstreu ! Ablenkung aus vorheriger Richtung in der Folie + real phiAufstreu ! azimuthaler Winkel der Ablenkung gegenueber Horiz. + COMMON /FOLIE/ E_Verlust,thetaAufstreu,phiAufstreu + + real Beschl_Faktor ! Faktor bei Berechn. der Beschleunigung im EFeld + COMMON /BESCHL_FAKTOR/ Beschl_Faktor + + real length1 ! = d_Folie_Achse + MappenLaenge_FO + real length2 ! = xTD - d_Folie_Achse - MappenLaenge_FO ! = xTD-length1 + + +c Groessen der Folienelektronen ('FE'): + + integer nFE ! jeweilige Anzahl an FE (2 <= nFE <= 5) + real E0FE ! Startenergie der Folienelektronen + real ct0,st0,cf0,sf0 ! die Winkelfunktionen der Startwinkel der FE + real f0 ! 'phi0' fuer die FE + real x0FE(3) ! Startort der Folienelektronen auf der TD-Folie + real xFE(3),vFE(3) ! Ort und Geschw. der FE + real tFE ! Zeit + real tFE_min ! kuerzeste gueltige FE-Flugzeit je Projektil + integer tFE_(5) /-1,-1,-1,-1,-1/ ! Flugzeit jedes FE in ps (fuer NTP) + + COMMON /S1xM2/ S1xM2 ! fuer NTupel + COMMON /TIMES/ S1M2,S1Fo,FoM2,S1M3,M3M2,tFE_ ! fuer NTupel + common /FoM2Only/ FoM2Only + COMMON /S1FoOnly/ S1FoOnly + +c Variablen fuer den allgemeinen Programmablauf: + + integer qIndxMu + common /qIndxMu/ qIndxMu + + integer ntpid(1) ! fuer das Einlesen des NTupels von ACCEL oder von + integer ntpnr ! FoilFile + + integer firstEventNr + external firstEventNr + + logical NTPalreadyWritten + + real Spiegel_Faktor ! Faktor bei Berechn. der Reflektionszeit im Spiegel + + integer bis_Spiegel ! verschiedene Label + integer bis_L3_Mappe, bis_MCP2_Mappe, MCP2_Mappe + + character uhrzeit*8 + + integer percent_done + logical fill_NTP + + real radiusQuad_HeShield + real radiusQuad_LNShield + real radiusQuad_L1 + real radiusQuad_L2 + real radiusQuad_L3 + real radiusQuad_Blende + real radiusQuad_Rohr + real radiusQuad_MCP2 ! Radiusquadrat des MCP2 + real radiusQuad_MCP2active ! Radiusquadrat der aktiven Flaeche des MCP2 + real radiusQuad_Sp ! Radiusquadrat der Spiegeldraehte + real rWires_Sp ! Radius der Spiegeldraehte + + logical check_Blende /.false./ + + real xChangeKoord ! legt den Ort nach dem Spiegel fest, bei + parameter (xChangeKoord = 75.) ! dem das Koordinatensystem gewechselt wird + + integer n_return ! die Returnvariable fuer Aufruf von 'TD_CALC' + integer zaehler ! Zaehler fuer Monitoring der Trajektorie in den + ! Gebieten, in denen stepwise integriert werden + ! muss + logical flag, flag_ok + integer okStepsCounter + + integer i, k ! integer-Hilfsvariablen + real help1, help2 ! real-Hilfsvariablen + real help3, help4 ! real-Hilfsvariablen + + real YieldPlus,YieldNeutral ! Ladungsanteile nach TD-Foliendurchgang + + integer startLabel ! das Einsprunglabel beim Teilchenstart + + character helpChar*7, ant*1 + character HistogramTitle*32 /'Schnitt bei x = (i. Teil)'/ + +d real dtmin_L1, dtmin_Sp, dtmin_L2andFo, dtmin_FO, dtmin_L3, dtmin_M2 +d real dtmax_L1, dtmax_Sp, dtmax_L2andFo, dtmax_FO, dtmax_L3, dtmax_M2 +d real x_dtmin_L1(3), x_dtmax_L1(3), x_dtmin_FO(3), x_dtmax_FO(3) +d real x_dtmin_L2andFo(3), x_dtmax_L2andFo(3) +d real x_dtmin_L3(3), x_dtmax_L3(3), x_dtmin_M2(3), x_dtmax_M2(3) +d real x_dtmin_Sp(3), x_dtmax_Sp(3) +d +d ! /ntp_steps/ enthaelt auch 'steps' (ueber COM-MUTRACK.INC) +d COMMON /ntp_steps/ dtmin_L1, x_dtmin_L1, dtmax_L1, x_dtmax_L1, +d + dtmin_Sp, x_dtmin_Sp, dtmax_Sp, x_dtmax_Sp, +d + dtmin_L2andFo, x_dtmin_L2andFo, dtmax_L2andFo, x_dtmax_L2andFo, +d + dtmin_FO, x_dtmin_FO, dtmax_FO, x_dtmax_FO, +d + dtmin_L3, x_dtmin_L3, dtmax_L3, x_dtmax_L3, +d + dtmin_M2, x_dtmin_M2, dtmax_M2, x_dtmax_M2 + + real x40(2:3),v40(3),t40,E40 ! Speicher fuer Trajektoriengroessen bei x=40mm + COMMON /NTP_40mm/ x40,v40,t40,E40 + +cMBc logical writeTraj2File +cMBc common /writeTraj2File/ writeTraj2File + + +c Variablen fuer Test ob Draht getroffen wurde: + + real distToWire(2) + integer DrahtNr + logical WireHit + + real WireRadiusQuad_G1,WireRadiusQuad_G2 + real WireRadiusQuad_Sp + + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000),xKoord_(1000) ! Koordinatenfelder fuer die + real yKoord(1000),yKoord_(1000) ! Graphikausgabe + real zKoord(1000),zKoord_(1000) ! +cMBc real tKoord(1000),tKoord_(1000) ! + integer nKoord,nKoordSave ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord + + +c Variablen fuer HBOOK und PAW: + + integer istat ! fuer HBOOK-Fehlermeldungen + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory ! Der Arbeitsbereich fuer HBOOK + + +c Konstanten: + + real c ! Lichtgeschwindigkeit in mm/ns + real meanLifeTime ! mittlere Myon-Lebensdauer in ns + + parameter (c = 299.7925, meanLifeTime = 2197) + +c------------------------------------------------------------------------------- +c Konstanten und Variable fuer Berechnung der Winkelaufstreuung in Triggerfolie +c mittels Meyer-Formel (L.Meyer, phys.stat.sol. (b) 44, 253 (1971)): + + real g1, g2 ! Tabellierte Funktionen der Referenz + real effRedThick ! effektive reduzierte Dicke ('tau' der Referenz) + + +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target + real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + real HWHM2sigma ! Umrechnungsfaktor von (halber!) Halbwertsbreite + ! nach Sigma der Gaussfunktion + + real Na ! die Avogadrokonstante + real mMolC ! molare Masse von C in ug + real Pi ! die Kreiszahl + + parameter (Z1 = 1, Z2 = 6, a0 = 5.29E-9, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10, HWHM2sigma = 1./1.17741) + parameter (Na = 6.022e23, mMolC = 12.011e6, Pi = 3.141592654) + + +c - Bei der Berechnung von Sigma auftretende Vorfaktoren. +c (Meyer_faktor 1 wird benoetigt fuer Berechnung der reduzierten Dicke aus der +c 'ug/cm2'-Angabe der Foliendicke. Meyer_faktor2 und Meyer_faktor3 werden +c direkt fuer die Berechnung von sigma aus den beiden tabellierten Funktionen +c g1 und g2 verwendet): + + real Meyer_Faktor1, Meyer_Faktor2, Meyer_Faktor3 + + parameter (Meyer_faktor1 = Pi*screeningPar*screeningPar * Na/mMolC) + ! Na/mMolC = 1/m(C-Atom) + parameter (Meyer_faktor2 = (2*Z1*Z2 * eSquare)/ScreeningPar * 180./Pi + + * HWHM2sigma) + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + + +c------------------------------------------------------------------------------- +c Kommentar zur Berechnung der Winkelaufstreuung nach Meyer: +c +c Als Bedingung fuer die Gueltigkeit der Rechnung wird verlangt, dass +c +c (1) die Anzahl n der Stoesse >> 20*(a/r0)^(4/3) sein muss. Fuer Protonen auf +c Graphit ist laut Referenz a/r0 gleich 0.26 (mit Dichte von 3.5 g/ccm habe +c ich einen Wert von 0.29 abgeschaetzt). Fuer Myonen hat man den selben +c Wert zu nehmen. Damit ergibt sich die Forderung, dass n >> 3.5 sein muss. +c +c (2) unabhaengig von (1) n >> 5 sein muss, was (1) also mit einschliesst. +c +c Mit n = Pi*r0*r0*Teilchen/Flaeche ergibt sich fuer eine Foliendicke von +c 3 ug/cm^2 als Abschaetzung fuer n ein Wert von 37. (r0 ueber r0 = 0.5 N^(1/3) +c und 3.5 g/ccm zu 8.9e-9 cm abgeschaetzt). D.h., dass die Bedingungen in +c unserem Fall gut erfuellt sind. +c In dem Paper wird eine Formel fuer Halbwertsbreiten angegeben. Ich habe nicht +c kontrolliert, in wie weit die Form der Verteilung tatsaechlich einer Gauss- +c verteilung entspricht. Zumindest im Bereich der Vorwaertsstreuung sollte +c die in diesem Programm verwendete Gaussverteilung aber eine sehr gute +c Naeherung abgeben. Abweichungen bei groesseren Winkeln koennten jedoch u. U. +c die absolute Streuintensitaet in Vorwaertsrichtung verfaelschen. + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER GEHT DER PROGRAMMTEXT RICHTIG LOS +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c Initialisierungen: + + INCLUDE 'mutrack$sourcedirectory:INITIALIZE.INC' + + +c Einlesen der Parameter aus 'MUTRACK.INPUT' und Setzen der entsprechenden +c Voreinstellungen. Einlesen der Kammergeometrie sowie der INFO-files der +c Feldmappen: + + call read_inputFile + + +c Berechnen der RadiusQuadrate: + + radiusQuad_HeShield = rHeShield*rHeShield + radiusQuad_LNShield = rLNShield*rLNShield + radiusQuad_Rohr = radius_Rohr*radius_Rohr + radiusQuad_L1 = iRadiusCyl_L1*iRadiusCyl_L1 + radiusQuad_L2 = iRadiusCyl_L2*iRadiusCyl_L2 + radiusQuad_L3 = iRadiusCyl_L3*iRadiusCyl_L3 + radiusQuad_Blende = radius_Blende*radius_Blende + radiusQuad_MCP2 = radius_MCP2*radius_MCP2 + radiusQuad_MCP2active = radius_MCP2active*radius_MCP2active + WireRadiusQuad_G1 = dWires_G1/2. * dWires_G1/2. + WireRadiusQuad_G2 = dWires_G2/2. * dWires_G2/2. + WireRadiusQuad_Sp = dWires_Sp/2. * dWires_Sp/2. + rWires_Sp = dWires_Sp/2. + radiusQuad_Sp = rWires_Sp * rWires_Sp + + +c Einlesen der Feldmappen: + + write(*,*)'----------------------------------------'// + + '----------------------------------------' + if (.NOT.(par(1,UL1).EQ.0. .AND. n_par(UL1).LE.1)) call READ_MAP_L1 + + if (.NOT.(idealMirror .OR. (par(1,USp).EQ.0. .AND. n_par(USp).LE.1))) then + call read_Map_SP_1 + call read_Map_SP_2 + call read_Map_SP_3 + endif + + if (TriggerInBeam .AND. .NOT.lense2 .AND. + ! 'lense2' muss noch in sub_input richtig gesetzt werden! (-> foilfile) + + .NOT.(par(1,UFolie).EQ.0. .AND. n_par(UFolie).LE.1) ) then + call READ_MAP_FO + endif + + if (.NOT.(par(1,UL3).EQ.0. .AND. n_par(UL3).LE.1)) then + if (.NOT.(par(1,UMCP2).EQ.0. .AND. n_par(UMCP2).LE.1)) then + if (xLeaveMap_L3.GT.xEnterMap_M2) then + write(*,*) + write(*,*)' Potentialmappen von Linse 3 und MCP2 ueberlappen!' + write(*,*)' Dies ist in der aktuellen Implementierung des Programmes' + write(*,*)' nicht vorgesehen!' + write(*,*) + write(*,*)' -> STOP' + write(*,*) + STOP + endif + endif + call READ_MAP_L3 + endif + + if (.NOT.(par(1,UMCP2).EQ.0. .AND. n_par(UMCP2).LE.1)) call READ_MAP_M2 + + +c Eingelesene Simulationsparameter auf Schirm geben und bestaetigen lassen. +c Die Ausgabefiles initialisieren: + + call initialize_output + + +c falls ein 'FoilFile' erstellt werden soll, schreibe das .INFO-files: + + if (createFoilFile) call make_INFOFile + if (Use_MUTRACK) Use_ACCEL = .false. + + +c Defaultwert fuer 'fill_NTP' setzen (wird weiter unten ueberschrieben, falls +c fuer das Fuellen des NTupels spezielle Triggerbedingung verlangt ist): + + if (createNTP) then + fill_NTP = .true. + else + fill_NTP = .false. + endif + + +c CERN-Pakete initialisieren (Groesse des COMMONblocks PAWC uebermitteln): + + if (.NOT.fromScratch.OR.Graphics.OR.createNTP.OR.createFoilFile) call HLIMIT(HB_memsize) + + +c Graphikausgabe initialisieren: + + if (GRAPHICS) then + call masstab_setzen + CALL HPLSET ('VSIZ',.6) ! AXIS VALUES SIZE + write(HistogramTitle(17:22),'(F6.1)') schnitt_x + write(HistogramTitle(25:25),'(I1)') schnitt_p + CALL HPLSET ('TSIZ',.7) ! HISTOGRAM TITLE SIZE + CALL HBOOK2 (50,HistogramTitle,100,-30.,30.,100,-30.,30.,20.) + endif + + +c falls fruehere Simulation fortgefuehrt werden soll, oeffne entsprechende Datei: + + if (.NOT.fromScratch) then + if (use_ACCEL) then + call HROPEN(lunREAD,'ACCEL',ACCEL_Dir//':'//fileName_ACCEL//'.NTP', + + ' ',1024,istat) + else + call HROPEN(lunREAD,'MUread',outDir//':'//fileName_MUTRACK//'.NTP', + + ' ',1024,istat) + endif + + call HRIN(0,99999,0) + call HIDALL(ntpid,ntpNr) + call HDELET(ntpid(1)) + i = NTP_read - ntpid(1) + call HRIN(NTP_read-i,9999,i) ! NTP_read = NTP_write+1 + call HBNAME(NTP_read,' ',0,'$CLEAR') ! alles resetten + + ! fuer die benoetigten Bloecke des CWN die entsprechenden Speicher- + ! lokalisationen uebermitteln: + + if (random_E0) call HBNAME(NTP_read,'E0',E0,'$SET') + if (random_pos) call HBNAME(NTP_read,'x0',x0,'$SET') + if (random_angle) call HBNAME(NTP_read,'angle0',theta0,'$SET') ! theta0,phi0 + if (UseDecay_prevSim) call HBNAME(NTP_read,'lifetime',lifetime,'$SET') + + if (smearS1Fo .AND. use_MUTRACK) then + call HBNAME(NTP_read,'S1FoS',S1FoOnly,'$SET') + endif + + call HBNAME(NTP_read,'dest',gebiet,'$SET') ! gebiet,destiny + call HBNAME(NTP_read,'Traj',t,'$SET') ! t,x,v + + endif + + +c NTP-relevante Befehle: + +c BAD LUCK!!! Das Packen der Real-Variablen im folgenden hat KEINERLEI VER- +c KLEINERUNG DER FILEGROESSE bewirkt!!!! (fuer die Integers habe ich noch +c keinen Test gemacht). -> wohl besser wieder herausnehmen. Ich verliere +c u.U. nur Genauigkeit und habe nur einen eingeschraenkten Wertebereich zur +c Verfuegung! + + if (createNtp.OR.createFoilFile) then + + !c Datei fuer NTupelausgabe oeffnen: + call HROPEN(lunNTP,'MUwrite',outDir//':'//filename//'.NTP', + + 'N',1024,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)'error ',istat,' opening HBOOK-file' + write(*,*) + STOP + endif + + call HBNT(NTP_write,filename,'D') ! D: Disk resident CWN buchen + + !c die Bloecke des CWN definieren: + + if (.NOT.OneLoop) call HBNAME(NTP_write,'LOOP',schleifenNr,'loop[1,1000]:u') + if (M2_triggered .OR. Fo_triggered.AND.upToTDFoilOnly) then + ! -> Gebiet und Destiny stehen hier sowieso fest, nimm + ! diese Groessen daher erst gar nicht mehr in das NTupel auf! + else + call HBNAME(NTP_write,'DEST',gebiet,'Gebiet[0,20]:u,dest[-10,10]:i') + endif + if (NTP_Start .OR. createFoilFile.AND.random_pos) then + call HBNAME(NTP_write,'X0',x0,'x0,y0,z0') + endif + if (NTP_Start) call HBNAME(NTP_write,'V0',v0,'vx0,vy0,vz0') + if (NTP_Start .OR. createFoilFile.AND.random_E0) then + call HBNAME(NTP_write,'E0',E0,'E0') + endif + if (NTP_Start .OR. createFoilFile.AND.random_angle) then + call HBNAME(NTP_write,'ANGLE0',theta0,'theta0,phi0') + endif + if (NTP_lifetime .OR. createFoilFile.AND.UseDecay) then + call HBNAME(NTP_write,'LIFETIME',lifetime,'lifetime:r') + endif + if (NTP_40mm) call HBNAME(NTP_write,'X=40MM',x40, + + 'y40,z40,t40,vx40,vy40,vz40,E40') + if (NTP_S1xM2) call HBNAME(NTP_write,'S1xM2',S1xM2,'S1xM2') + if (NTP_Times) then + if (TriggerInBeam) then + if (generate_FE) then + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2,S1Fo,FoM2,S1M3,M3M2:r,TFE(5):i') + else + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2,S1Fo,FoM2') + endif + else + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2') + endif + endif + if (NTP_FoM2Only) then + call HBNAME(NTP_write,'FoM2',FoM2Only,'FoM2') + endif + if (NTP_Folie) then + call HBNAME(NTP_write,'FOLIE',E_Verlust, + + 'ELoss,thetStreu,phiStreu') + endif + if (NTP_charge) call HBNAME(NTP_write,'CHARGE',qInt,'q[-5,5]:i') + if (NTP_stop.OR.createFoilFile) then + call HBNAME(NTP_write,'TRAJ',t,'t,x,y,z,vx,vy,vz') + endif +c if (createFoilFile .AND. smearS1Fo .AND. .NOT.NTP_times) then + if (smearS1Fo) then + call HBNAME(NTP_write,'S1FoS',S1FoOnly,'S1FoS') + endif + if (NTP_stop) then + call HBNAME(NTP_write,'EKIN',Ekin,'Ekin') + endif +d if (NTP_steps) then +d call HBNAME(NTP_write,'STEP',steps,'steps[1,100000]:u,'// +d + 'dtminL1, xdtminL1, ydtminL1, zdtminL1,'// +d + 'dtmaxL1, xdtmaxL1, ydtmaxL1, zdtmaxL1,'// +d + 'dtminL2, xdtminL2, ydtminL2, zdtminL2,'// +d + 'dtmaxL2, xdtmaxL2, ydtmaxL2, zdtmaxL2,'// +d + 'dtminFO, xdtminFO, ydtminFO, zdtminFO,'// +d + 'dtmaxFO, xdtmaxFO, ydtmaxFO, zdtmaxFO,'// +d + 'dtminL3, xdtminL3, ydtminL3, zdtminL3,'// +d + 'dtmaxL3, xdtmaxL3, ydtmaxL3, zdtmaxL3,'// +d + 'dtminM2, xdtminM2, ydtminM2, zdtminM2,'// +d + 'dtmaxM2, xdtmaxM2, ydtmaxM2, zdtmaxM2') +d endif + endif + + +c die Label definieren: + + assign 7 to bis_Spiegel + assign 14 to bis_L3_Mappe + assign 16 to bis_MCP2_Mappe + assign 17 to MCP2_Mappe + + +c die Einsprungposition fuer den Beginn der Trajektorienberechnungen setzen: + + if (Use_MUTRACK) then + assign 113 to startLabel + elseif (Use_ACCEL) then + assign 3 to startLabel + elseif (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + assign 1 to startLabel + elseif (Gebiet0.EQ.upToGrid2) then + assign 2 to startLabel + elseif (Gebiet0.EQ.upToHeShield) then + assign 3 to startLabel + elseif (Gebiet0.EQ.upToLNShield) then + assign 4 to startLabel + elseif (Gebiet0.EQ.upToL1Map) then + assign 5 to startLabel + elseif (Gebiet0.EQ.upToExL1) then + assign 6 to startLabel + elseif (Gebiet0.EQ.upToEnSp) then + assign 7 to startLabel + elseif (Gebiet0.EQ.upToExSp) then + assign 8 to startLabel + elseif (Gebiet0.EQ.upToChKoord) then + assign 9 to startLabel + elseif (Gebiet0.EQ.upToEnTD) then + assign 10 to startLabel + elseif (Gebiet0.EQ.upToExTD) then + if (log_alpha0_KS) then + assign 111 to startLabel + else + assign 112 to startLabel + endif + elseif (Gebiet0.EQ.upToL2andFoMap) then +c assign 12 to startLabel + elseif (Gebiet0.EQ.upToExL2) then +c assign 13 to startLabel + elseif (Gebiet0.EQ.upToL3Map) then + assign 12 to startLabel + elseif (Gebiet0.EQ.upToExL3) then + assign 13 to startLabel + elseif (Gebiet0.EQ.upToM2Map) then + assign 14 to startLabel + elseif (Gebiet0.EQ.upToMCP2) then + assign 15 to startLabel + endif + + +c Abkuerzungen 'Length1' und 'length2' setzen: + + length1 = d_Folie_Achse + MappenLaenge_FO + length2 = xTD - d_Folie_Achse - MappenLaenge_FO + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c ab hier beginnen die Schleifen: +c (Bemerkung: eine Laufvariable darf kein Feldelement sein!) +c +c Besonderheit der Massen- und der Ladungsschleife: +c Wurde im INPUT-File in der Variablen 'artList' eine Teilchenart spezifi- +c ziert (-> 'artList_defined'), so werden die Parameter Masse und Ladung nicht +c entsprechend den Inhalten von par(n,mass) bzw. par(n,charge) eingestellt, +c sondern entsprechend den zu den Teilchenarten gehoerenden Werten fuer diese +c Groessen. In diesem Fall besteht die Massenschleife aus genau einem (Leer-) +c Durchlauf, waehrend die Ladungsschleife fuer jede Teilchenart einen Durchlauf +c macht, in welcher dann die Einstellung von Ladung UND Masse stattfindet. +c +c Bei Aenderungen in der Abfolge der Schleifen muss die Anweisungszeile +c 'DATA reihenfolge /.../' in 'INITIALIZE.INC' entsprechend editiert werden! +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c zusaetliche Flugstrecken vor TD und MCP2 (gehen NUR in t, NICHT in x ein!!): +c ---------------------------------------------------------------------------- + + do 200 Delta_L1 = par(1,DeltaL1),par(2,DeltaL1),par(3,DeltaL1) + parWert(DeltaL1) = Delta_L1 + do 200 Delta_L2 = par(1,DeltaL2),par(2,DeltaL2),par(3,DeltaL2) + parWert(DeltaL2) = Delta_L2 + +c Foliendicke und Energieverlust: +c ------------------------------- + + do 200 E_loss = par(1,Eloss),par(2,Eloss),par(3,Eloss) ! Eloss + parWert(Eloss) = E_loss + mean_E_Verlust = E_loss + + do 200 Thickness = par(1,Thickn),par(2,Thickn),par(3,Thickn)! Thickness + parWert(Thickn) = Thickness + +c MCP2: +c ----- + + do 200 U_MCP2 = par(1,UMCP2),par(2,UMCP2),par(3,UMCP2) ! U(MCP2) + parWert(UMCP2) = U_MCP2 + +c Winkel: +c ------- + + do 200 alfaTgt = par(1,alfTgt),par(2,alfTgt),par(3,alfTgt) ! ALPHA(TARGET) + parWert(alfTgt) = alfaTgt + Sin_alfaTgt= sind(alfaTgt) + Cos_alfaTgt= cosd(alfaTgt) + + do 200 alfaSp = par(1,alfSp),par(2,alfSp),par(3,alfSp) ! ALPHA(SPIEGEL) + parWert(alfSp) = alfaSp + Sin_alfaSp = sind(alfaSp) + Cos_alfaSp = cosd(alfaSp) + Tan_alfaSp = tand(alfaSp) + help1 = dSpiegel/2.+DreharmLaenge + ! Berechne die y-Werte der 'oberen linken' (yUppLeft) und der + ! 'unteren linken' (yLowLeft) Spiegelecke: + if (idealMirror) then + yUppLeft = + bSpiegel/2. * Sin_alfaSp + + + help1 * Cos_alfaSp + yLowLeft = - bSpiegel/2. * Sin_alfaSp + + + help1 * Cos_alfaSp + endif + ! Berechne Schnittpunkt y_intersectSp der vorderen Spiegelebene bzw. + ! der vorderen Mappenkante mit der Geraden x = xSpiegel: + if (.NOT.idealMirror) help1 = help1 + xSpGrid1 + y_intersectSp = help1/Cos_alfaSp + + do 200 alfaTD = par(1,alfTD),par(2,alfTD),par(3,alfTD) ! ALPHA(TRIGGERDETEKTOR) + parWert(alfTD) = alfaTD + Sin_alfaTD = sind(alfaTD) + Cos_alfaTD = cosd(alfaTD) + Tan_alfaTD = tand(alfaTD) + ! Berechne Schnittpunkt 'x_intersectTD' der x-Achse mit der Folien- + ! ebene bzw im Fall von 'GridInFrontOfFoil' mit dem Gitter vor der + ! Triggerfolie: + help1 = d_Folie_Achse + if (gridInFrontOfFoil) help1 = help1 + d_Grid_Folie + x_intersectTD = xTD - help1/Cos_alfaTD + help1 = d_Folie_Achse + mappenLaenge_Fo + x_intersectTDMap = xTD - help1/Cos_alfaTD + +c TriggerDetektor: +c ---------------- + + do 200 U_V = par(1,UVorne),par(2,UVorne),par(3,UVorne) ! U(VORNE) + parWert(UVorne) = U_V + do 200 U_H = par(1,UHinten),par(2,UHinten),par(3,UHinten) ! U(HINTEN) + parWert(UHinten) = U_H + do 200 U_MCP3 = par(1,UMCP3),par(2,UMCP3),par(3,UMCP3) ! U(MCP3) + parWert(UMCP3) = U_MCP3 + do 200 U_F = par(1,UFolie),par(2,UFolie),par(3,UFolie) ! U(FOLIE) + parWert(UFolie) = U_F + +c Transportsystem: +c ---------------- + + do 200 U_L2 = par(1,UL2),par(2,UL2),par(3,UL2) ! U(Linse 2) + parWert(UL2) = U_L2 + +c gegebenenfalls die Mappe 'L2andFo' zusammenbauen: + if (lense2) then + if ( .NOT.(par(1,UL2).EQ.0. .AND. n_par(UL2).LE.1) .OR. + + .NOT.(par(1,UFolie).EQ.0. .AND. n_par(UFolie).LE.1) ) then + ! Addiere die Mappen nur erneut, falls die jetztige Konfiguration + ! nicht mit der letzten uebereinstimmt: + if (U_L2.NE.last_U_L2 .OR. U_F.NE.last_U_F) then + call ADD_MAP_L2andFo + last_U_L2 = U_L2 + last_U_F = U_F + endif + endif + endif + + do 200 U_Sp = par(1,USp),par(2,USp),par(3,USp) ! U(SPIEGEL) + parWert(USp) = U_Sp + + do 200 U_L1 = par(1,UL1),par(2,UL1),par(3,UL1) ! U(Linse 1) + parWert(UL1) = U_L1 + + do 200 U_L3 = par(1,UL3),par(2,UL3),par(3,UL3) ! U(Linse 3) + parWert(UL3) = U_L3 + +c die Magnetfelder: +c ----------------- + + do 200 B_Helm = par(1,BHelm),par(2,BHelm),par(3,BHelm) ! Helmholtzsp. + parWert(BHelm) = B_Helm + + do 200 B_TD = par(1,BTD),par(2,BTD),par(3,BTD) ! TD-Spule + parWert(BTD) = B_TD + +c Masse und Ladung: +c ----------------- + + do 200 m_ = par(1,mass),par(2,mass),par(3,mass) ! MASSE + if (.NOT.artList_defined) then + m = m_ + parWert(mass) = m + endif + + do 200 q_ = par(1,charge),par(2,charge),par(3,charge) ! LADUNG + if (.NOT.artList_defined) then + q = q_ + parWert(charge) = q + else + qIndxMu = q_ ! fuer Verwendung in function firstEventNr! + ArtNr = Art_Nr(q_) + m = Art_Masse(ArtNr) + q = Art_Ladung(ArtNr) + parWert(mass) = m + parWert(charge) = q + endif + ! gegebenenfalls ein Flag fuer die Beruecksichtigung des Myonen- + ! zerfalles setzen: + if (useDecay) then ! 'useDecay' setzt 'artList_defined' voraus + if (ArtNr.LE.4) then! es ist ein Myon involviert + useDecay_ = .true. + else ! kein Myon involviert + useDecay_ = .false. + endif + endif + + +c Beschleuniger: +c -------------- + + do 200 U_Tgt = par(1,UTgt),par(2,UTgt),par(3,UTgt) ! U(TARGET) + parWert(UTgt) = U_Tgt + do 200 U_Gua = par(1,UGua),par(2,UGua),par(3,UGua) ! U(GUARD) + parWert(UGua) = U_Gua + do 200 U_G1 = par(1,UG1),par(2,UG1),par(3,UG1) ! U(GITTER) + parWert(UG1) = U_G1 + parIndx(5) = parIndx(5) + 1 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c haeufig benoetigte Faktoren, die von der aktuellen Masse, Ladung und Hoch- +c spannungen abhaengen: +c (bei Linse 2 wird die Spannung direkt auf die Potentialmappe aufmultipliziert. +c Daher wird dort 'Beschl_Faktor' verwendet und kein 'Beschl_Faktor_L2' benoetigt) + + Energie_Faktor = m / (2.*c*c) + Beschl_Faktor = q / m * c*c + Beschl_Faktor_L1 = Beschl_Faktor * U_L1 + Beschl_Faktor_Sp = Beschl_Faktor * U_Sp + Beschl_Faktor_FO = Beschl_Faktor * U_F + Beschl_Faktor_L3 = Beschl_Faktor * U_L3 + Beschl_Faktor_M2 = Beschl_Faktor * U_MCP2 + + aFoil = - Beschl_Faktor * U_F / d_Grid_Folie + if (U_Sp.EQ.0. .OR. q.EQ.0.) then + Spiegel_Faktor = 0 + else + Spiegel_Faktor = 2.*dspiegel / (Beschl_Faktor * U_Sp) !<-- pruefen! + endif + + ! Die Beschleunigungen in den beiden (idealen) Beschleunigerstufen: + a1 = Beschl_Faktor * (U_Tgt - U_G1) / (XGrid1 - XTarget) + a2 = Beschl_Faktor * U_G1 / (XGrid2 - xGrid1) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Falls 'fromScratch': +c Die in den ab hier beginnenden Startparameter-Schleifen gesetzten Werte +c werden gegebenenfalls weiter unten durch zufallsverteilte Offsets modi- +c fiziert. (-> 'Zufallschleife': 'do 100 randomloop_ = 1, n_par(0)) +c Andernfalls: +c Wurden waehrend ACCEL oder 'foilfile' fuer die Startparameter Zufalls- +c verteilungen verwendet, so werden die entsprechenden Groessen aus dem +c betreffenden NTupel eingelesen. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Startparameter: +c --------------- + + do 200 E0_ = par(1,ener),par(2,ener),par(3,ener) ! E0 + if (.NOT.random_E0) then + E0 = E0_ + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (E0InterFromFile) then + lowerE0 = E0Low(nInt(E0_)) + upperE0 = E0Low(nint(E0_+1)) + endif + + +c falls Energieverlustberechnung aus ICRU-Tabelle verlangt ist und mittlerer +c Energieverlust nicht fuer jedes Teilchen extra berechnet werden soll (sinnvoll +c wenn alle Teilchen gleiche Startenergie haben oder Streuung der Startenergien +c klein ist, so dass die Streuung des mittleren Energieverlustes vernachlaessigt +c werden kann): + + if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,mean_E_Verlust) + endif + + if (log_Meyer_F_Function) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + effRedThick = Meyer_Faktor1 * Thickness + call Get_F_Function_Meyer(effRedThick,Ekin) + endif + + do 200 theta0_ = par(1,thetAng),par(2,thetAng),par(3,thetAng) ! theta0 + if (.NOT.random_angle) then + theta0 = theta0_ + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + do 200 phi0_ = par(1,phiAng),par(2,phiAng),par(3,phiAng) ! phi0 + if (.NOT.random_angle) then + phi0 = phi0_ + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + do 200 y0_ = par(1,yPos),par(2,yPos),par(3,yPos) ! y0 + if (.NOT.random_pos) then + x0(2) = y0_ + endif + + do 200 z0_ = par(1,zPos),par(2,zPos),par(3,zPos) ! z0 + if (.NOT.random_pos) then + x0(3) = z0_ + endif + +c die folgenden parWert(n) werden u.U. in der 'Zufallsschleife' weiter unten +c abgeaendert. Hier werden sie in jedem Fall fuer Tabellenausgaben, Debug- +c angelegenheiten u.s.w. erst einmal mit den aktuellen Werten der +c entsprechenden Schleifen gefuellt: + + parWert(ener) = E0_ + parWert(thetAng) = theta0_ + parWert(phiAng) = phi0_ + parWert(yPos) = y0_ + parWert(zPos) = z0_ + + +c falls fruehere Simulation fortgefuehrt wird: +c Berechne diejenige Eventnummer in NTP_read, ab welcher die relevanten +c Simulationsparameter von ACCEL bzw. des 'FoilFiles' mit den gegenwaertigen +c MUTRACK-(Schleifen)-Parametern uebereinstimmen: + + if (.NOT.fromScratch) eventNr = firstEventNr() + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die Befehle, die zu Beginn jeder neuen Schleife faellig sind: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + SchleifenNr = SchleifenNr + 1 ! Schleifen zaehlen + okStepsCounter = 0 ! 'okStepsCounter' dient der Bestimmung + ! der mittleren Anzahl von Integrations- + ! schritten bis zum Ziel + nNeutral = 0 ! noch wurden keine Teilchen in der TD-Folie + nCharged = 0 ! neutralisiert + +c Die Statistikspeicher resetten: +c Falls nur ein Teilchenstart pro Schleife erfolgt, nimm die Statistik ueber +c alle Schleifen. (Dann erfolgt der Reset nur bei der ersten Schleife): + + flag_ok = (.NOT.(OneStartPerLoop .AND. SchleifenNr.GT.1)) + + if (flag_ok) call reset_statistics + + +c Die Kammer zeichnen: +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Zeichne die Kammer dann also nur bei der ersten Schleife. + + if (GRAPHICS .AND. flag_ok) then + CALL IZPICT ('CHAM_1','M') ! ERZEUGEN VON BILDERN IM PAWC-COMM-BLOCK + CALL IZPICT ('CHAM_2','M') + CALL IZPICT ('HISTO','M') + CALL IZPICT ('TEXT','M') + call plot_chamber(schnitt_p) + call Graphics_Text ! Text fuer Textwindow erstellen + call text_plot ! Ausgabe des Textes + endif + + +c Ausgabe der aktuellen Settings: +c Auch dies im Falle von 'OneStartPerLoop' nur bei der ersten Schleife: + + if ((n_outWhere.NE.0 .OR. smallLogFile) .AND. flag_ok) then + call output_new_loop(q_) ! (q_) wegen der neutral fractions + endif + + +c Ausgabe der Prozentzahl schon gerechneten Trajektorien vorbereiten: + + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,1001)Uhrzeit,' %: 0' + endif +1001 format ($,6x,A,A) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c bei 'fromScratch': +c Hier wird gegebenenfalls bei Zufallsverteilung von Startparametern ein ent- +c sprechend gewuerfelter Offset auf den aktuellen Wert aufgeschlagen. +c Ansonsten: +c Lies bei Zufallsverteilungen die entsprechenden Startwerte aus dem NTupel +c ein. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + do 100 randomloop_ = 1, n_par(0) + + if (.NOT.fromScratch) then + + eventNr = eventNr + 1 ! Eventnummer im NTP + + if (smearS1Fo.AND.use_MUTRACK) call HGNTB(NTP_read,'S1FoS',eventNr,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)' error executing ''call HGNTB(',NTP_read,',''S1FoS'',eventNr,istat)''' + write(*,*)' eventNr = ',eventNr + write(*,*)' -> STOP' + write(*,*) + call exit + endif + + ! Einlesen von 'Gebiet' und 'destiny': + call HGNTB(NTP_read,'dest',eventNr,istat) + ! gegebenenfallsvon freuher verwendete Gebietskodierung + ! (ohne Linse2) aktualisieren + if (gebiet.GE.10 .AND. MutrackVersionIndx.LE.1) gebiet = gebiet+2 + +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''dest'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + ! Einlesen der Trajektoriendaten 't,x(3),v(3)': + call HGNTB(NTP_read,'Traj',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''Traj'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + + if (Use_Accel) then + ! Uebersetzen der von ACCEL verwendeten code_Nummern fuer die + ! moeglichen Teilchenschicksale in von MUTRACK verwendete + ! code_Nummern: + if (destiny.EQ.-5) then + destiny = code_frontOfMapAc + elseif (destiny.EQ.-4) then + destiny = code_leftMapAc + elseif (destiny.EQ.-3) then + gebiet = upToGrid2 + destiny = code_grid + elseif (destiny.EQ.-2) then + gebiet = upToGrid1 + destiny = code_grid + elseif (destiny.EQ.-1) then + destiny = code_hit_TgtHolder + elseif (destiny.EQ.code_ok) then + Gebiet = upToHeShield + elseif (destiny.EQ.+1) then + destiny = code_decay + elseif (destiny.EQ.+2) then + destiny = code_reflektiert + elseif (destiny.EQ.+3) then + destiny = code_wand + elseif (destiny.EQ.+4) then + destiny = code_lost + elseif (destiny.EQ.+5) then + destiny = code_dtsmall + else + write(*,*)'UNKNOWN ACCEL-CODE-NR: destiny = ',destiny + call exit + endif + + ! Auf xGrid2 zurueckrechnen, damit unabhaengiger Test auf + ! Treffer des He-Fensters gemacht werden kann (nur, falls + ! Teilchen nicht schon anderweitig gestorben ist). Auch + ! notwendig fuer Graphikausgabe. + + if (destiny.EQ.0) then + dt = (xGrid2-x(1))/v(1) ! < 0. + t = t + dt + x(1) = xGrid2 + x(2) = x(2)+v(2)*dt + x(3) = x(3)+v(3)*dt + endif + + ! falls Kryo verdreht ist, rechne in Kammerkoordinaten um: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + help1 = x(1) + x(1) = help1 * Cos_alfaTgt - x(3) * Sin_alfaTgt + x(3) = help1 * Sin_alfaTgt + x(3) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(3) * Sin_alfaTgt + v(3) = help1 * Sin_alfaTgt + v(3) * Cos_alfaTgt + else + help1 = x(1) + x(1) = help1 * Cos_alfaTgt - x(2) * Sin_alfaTgt + x(2) = help1 * Sin_alfaTgt + x(2) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(2) * Sin_alfaTgt + v(2) = help1 * Sin_alfaTgt + v(2) * Cos_alfaTgt + endif + endif + + endif + + endif + + if (random_E0) then ! random_ENERGIE + if (fromScratch) then + if (random_E0_equal) then ! -> gleichverteilt +300 E0 = E0_ + lowerE0 + (upperE0 - lowerE0)*ran(seed) + if (E0.LT.0) goto 300 + elseif (random_E0_gauss) then ! -> gaussverteilt +310 call Gauss_Verteilung(sigmaE0,help1) + E0 = E0_ + help1 + if (E0.LT.0) goto 310 + endif + else + ! Einlesen von 'E0' aus NTP: + call HGNTB(NTP_read,'E0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(NTP_read,''E0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + parWert(ener) = E0 + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (random_pos) then ! random_POSITION + if (fromScratch) then + if (random_y0z0_equal) then ! -> rechteckig, gleichverteilt + x0(2) = StartBreite * (ran(seed)-.5) + x0(3) = StartHoehe * (ran(seed)-.5) + elseif (random_y0z0_Gauss) then ! -> rechteckig, Gaussverteilt +320 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + if (abs(x0(2)).GT.StartBreite/2.) goto 320 + x0(3) = r0 * sind(phi_r0) + if (abs(x0(3)).GT.StartHoehe/2.) goto 320 + elseif (random_r0_equal) then ! -> rund, gleichverteilt + r0 = StartRadius * sqrt(ran(seed)) + phi_r0= 360. * ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + elseif (random_r0_Gauss) then ! -> rund, Gaussverteilt +330 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + if (r0.GT.StartRadius) goto 330 + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + endif + x0(2) = y0_ + x0(2) + x0(3) = z0_ + x0(3) + else + ! Einlesen von 'x0(3)' aus NTP: + call HGNTB(NTP_read,'x0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''x0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + parWert(yPos) = x0(2) + parWert(zPos) = x0(3) + endif + + if (random_angle) then ! random_WINKEL + if (fromScratch) then +340 if (random_lambert) then ! -> Lambert-verteilt + call lambert_verteilung(StartLambertOrd, + + Cos_theta0,Sin_theta0) + theta0 = acosd(Cos_theta0) + elseif (random_gauss) then + call Gauss_Verteilung_theta(sigmaWinkel,theta0) + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + + phi0 = 360.*ran(seed) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + + if (angle_offset) then + +c -> Es soll aus gewuerfelter Startrichtung (theta0,phi0) und durch die Winkel- +c schleifen vorgegebenen Startrichtung (theta0_,phi0_) die tatsaechliche +c Startrichtung berechnet werden. Dafuer werden die gewuerfelten Winkel als +c 'Streuwinkel' betrachtet. +c Vorgehensweise: +c Es werden die Komponenten eines Geschwindigkeitsvektors mit Betrag=1 und durch +c theta0_,phi0_ bestimmter Richtung berechnet. Danach werden die Komponenten des +c mit theta0,phi0 gestreuten Geschwindigkeitsvektors und die zugehoerigen Winkel +c gewonnen, die dann als neuetheta0,phi0 als die tatsaechlichen Startwinkel +c verwendet werden. Das alles geschieht vollkommen analog zur Winkelaufstreuung +c in der Triggerfolie. +c v wird als Hilfsvariable missbraucht. + + ! Berechnung der 'Geschwindigkeitskomponenten': + v(1) = cosd(theta0_) + help1 = sind(theta0_) + v(2) = help1 * cosd(phi0_) + v(3) = help1 * sind(phi0_) + ! v_xy ist stets groesser 0 ausser wenn die Zentralrichtung + ! senkrecht nach oben oder unten gerichtet ist. Diese Wahl ist + ! aber sowieso wenig sinnvoll: + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) + if (v_xy.EQ.0.) then + write(*,*) + write(*,*)' Bei Zufallsverteilung fuer Startwinkel darf die durch die Winkelschleifen' + write(*,*)' vorgegebene Zentralrichtung nicht senkrecht nach oben oder nach unten weisen!' + write(*,*)' -> STOP' + STOP + endif + ! berechne neue 'Geschwindigkeitskomponenten': + help1 = v(1) + help2 = v(2) + help3 = Sin_theta0*Cos_phi0/v_xy + help4 = Sin_theta0*Sin_phi0 + v(1) = Cos_theta0*help1 - help3*help2 - help4*help1*v(3)/v_xy + if (v(1).LT.0.) goto 340 + v(2) = Cos_theta0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = Cos_theta0*v(3) + help4*v_xy + ! Berechne tatsaechlichen Startwinkel: + if (v(2).EQ.0. .AND. v(3).EQ.0.) then + if (v(1).GE.0) then + theta0 = 0. + else + theta0 = 180. + endif + phi0 = 0. + else + theta0 = acosd(v(1)) + phi0 = atan2d(v(3),v(2)) + if (phi0.LT.0) phi0 = phi0+360. + endif + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + if (theta0.GT.90.) goto 340 + + else + + ! Einlesen von 'theta0' und 'phi0' aus NTP: + call HGNTB(NTP_read,'angle0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''angle0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + + endif + + parWert(thetAng) = theta0 + parWert(phiAng) = phi0 + + endif + + ! Berechnung der Start-Geschwindigkeitskomponenten: + v0(1) = v0_Betrag * Cos_theta0 + v0(2) = v0_Betrag * Sin_theta0 * Cos_phi0 + v0(3) = v0_Betrag * Sin_theta0 * Sin_phi0 + + if (fromScratch) then + ! den Zeit-Speicher resetten: + t = 0. + ! Startparameter in Koordinatenspeicher uebergeben: + do i = 1, 3 + x(i) = x0(i) + v(i) = v0(i) + enddo + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die restl. Vorbereitungen zum Start des individuellen Projektils: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c n_dtsmall resetten: + + n_dtsmall = 0 + + +c Aufstreuwinkel resetten: + + thetaAufstreu = 0. + phiAufstreu = 0. + + +c x-Komponente der Startgeschwindigkeit ueberpruefen: + + if (v0(1).LT.0) then + write(*,*) + write(*,*) ' >>>> v(x) beim Start negativ!' + write(*,*) + call exit + endif + + +c die Lebensdauer wuerfeln: +c (wird eine fruehere Simulation fortgefuehrt und wurde dort bereits der Myonen- +c zerfall beruecksichtigt, so verwende die dort gewuerfelten Lebenszeiten) + + if (UseDecay_) then + if (.NOT.UseDecay_prevSim) then +350 lifeTime = -meanlifeTime * Log(Ran(seed) + 1.0E-37) + if (lifeTime.LE.0.) goto 350 + elseif (.NOT.fromScratch) then + call HGNTB(NTP_read,'lifetime',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''lifetime'',eventNr,istat)''' +c write(*,*)' eventNr = ', eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + endif + + +c die Ladung resetten (falls in der Folie Neutralisierung stattgefunden hat): +c ('qInt' wird fuer 'NTP_charge' benoetigt) + + q = parWert(charge) + qInt = int(q) + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien: + + if (log_percent) then + if (100.*real(start_nr(1))/real(n_par(0)) + + .GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,1002) percent_done + endif + endif +1002 format ($,'+',I3) + + +c andere Variablen auf den richtigen Stand bringen: + + if (fromScratch) then + destiny = code_ok ! bis jetzt ist dem Teilchen noch nichts zugestossen + Gebiet = Gebiet0 + endif + + start_nr(1) = start_nr(1) + 1 ! Projektil-Startnummer erhoehen + steps = 0 ! es wurden noch keine Integrationsschritte durchgefuehrt + NTPalreadyWritten = .false. ! fuer 'createFoilFile' + + +c die DEBUG-Daten ausgeben: + + if (Debug .AND. start_Nr(1).LE.DEBUG_Anzahl) then + Debug_ = .true. + call output_new_particle + call Output_Debug + else + Debug_ = .false. + endif + + +c StartKoordinaten fuer Graphikausgabe sichern: + + if (graphics .AND. (start_Nr(1).LE.graphics_Anzahl .OR. OneStartPerLoop)) then + graphics_ = .true. + if (Use_ACCEL) then + nKoord = 1 + xKoord(1) = x0(1) + yKoord(1) = x0(2) + zKoord(1) = x0(3) + else + nKoord = 0 + endif + if (.NOT.(Use_MUTRACK.OR.Gebiet0.EQ.upToExTD)) call Save_Graphics_Koord + else + graphics_ = .false. + endif + + +c gegebenenfalls 'fill_NTP' resetten: + + if (Fo_triggered.OR.M2_triggered.OR.xM2_triggered) fill_NTP = .false. + + +c Falls Schrittweiteninformationen im NTupel verlangt sind: Speicher resetten +c und Startkoordinaten sichern: + +d if (NTP_steps) then +d dtmin_L1 = +1.e10 +d x_dtmin_L1(1) = 0 +d x_dtmin_L1(2) = 0 +d x_dtmin_L1(3) = 0 +d dtmax_L1 = -1.e10 +d x_dtmax_L1(1) = 0 +d x_dtmax_L1(2) = 0 +d x_dtmax_L1(3) = 0 +d +d dtmin_L2andFo = +1.e10 +d x_dtmin_L2andFo(1) = 0 +d x_dtmin_L2andFo(2) = 0 +d x_dtmin_L2andFo(3) = 0 +d dtmax_L2andFo = -1.e10 +d x_dtmax_L2andFo(1) = 0 +d x_dtmax_L2andFo(2) = 0 +d x_dtmax_L2andFo(3) = 0 +d +d dtmin_FO = +1.e10 +d x_dtmin_FO(1) = 0 +d x_dtmin_FO(2) = 0 +d x_dtmin_FO(3) = 0 +d dtmax_FO = -1.e10 +d x_dtmax_FO(1) = 0 +d x_dtmax_FO(2) = 0 +d x_dtmax_FO(3) = 0 +d +d dtmin_L3 = +1.e10 +d x_dtmin_L3(1) = 0 +d x_dtmin_L3(2) = 0 +d x_dtmin_L3(3) = 0 +d dtmax_L3 = -1.e10 +d x_dtmax_L3(1) = 0 +d x_dtmax_L3(2) = 0 +d x_dtmax_L3(3) = 0 +d +d dtmin_M2 = +1.e10 +d x_dtmin_M2(1) = 0 +d x_dtmin_M2(2) = 0 +d x_dtmin_M2(3) = 0 +d dtmax_M2 = -1.e10 +d x_dtmax_M2(1) = 0 +d x_dtmax_M2(2) = 0 +d x_dtmax_M2(3) = 0 +d endif + + if (NTP_40mm) then + x40(2) = 0. + x40(3) = 0. + v40(1) = 0. + v40(2) = 0. + v40(3) = 0. + t40 = 0. + E40 = 0. + endif + + +c Die Flugzeiten resetten: + + S1xM2 = 0. + S1M2 = 0. + S1Fo = 0. + FoM2 = 0. + S1M3 = 0. + M3M2 = 0. + + +c Falls das Teilchen schon nicht mehr existiert, gehe gleich zur Ausgabe: + + if (destiny.NE.code_ok) goto 555 ! (nur bei '.NOT.fromScratch' moeglich) + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c hier starten die Projektile: +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + goto startLabel ! StartLabel = Gebiet0 als label + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c erste Beschleunigerstufe: (homogenes Feld) + +1 Gebiet = upToGrid1 + steps = Steps + 1 + + if (a1.NE.0.) then + help1 = v(1)*v(1) + 2.*a1*(xGrid1-x(1)) + if (help1.LT.0) then ! Reflektion noch vor 1. Gitter + dt = -2*v(1)/a1 + t = t + dt + !x(1) bleibt unveraendert + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/a1 + ! (ergibt sich aus x=v*t+1/2*a*t**2 mit richtiger V.Z.-Wahl ('+')) + v(1) = v(1) + a1*dt + else + if (v(1).EQ.0) then + write(*,*) + write(*,*)'ERROR: v(x) beim Start = 0. und '// + + 'Beschleunigung = 0' + write(*,*) + STOP + endif + dt = (xGrid1-xTarget) / v(1) + endif + + t = t + dt + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + x(1) = xGrid1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + +c - Aufgeschlagen? + + if (Abs(x(2)).gt.dygrid1/2. .OR. + + Abs(x(3)).gt.dzgrid1/2.) then + flag = .true. + destiny = code_wand + else + flag = .false. + endif + +c - Gitterstab getroffen? + + if (testOnWireHit) then + DrahtNr = nInt(x(2)/dist_Wires_G1) + distToWire(1) = 0. + distToWire(2) = x(2) - DrahtNr * dist_Wires_G1 + call Test_WireHit(distToWire,WireRadiusQuad_G1,v(1),v(2),WireHit) + if (WireHit) then + flag = .true. + destiny = code_grid + endif + endif + +c - Koordinatentransformation in Kammersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + help1 = x(3) + help2 = v(1) + help3 = v(3) + x(1) = xgrid1 * Cos_alfaTgt - help1 * Sin_alfaTgt + x(3) = xgrid1 * Sin_alfaTgt + help1 * Cos_alfaTgt + v(1) = help2 * Cos_alfaTgt - help3 * Sin_alfaTgt + v(3) = help2 * Sin_alfaTgt + help3 * Cos_alfaTgt + else + help1 = x(2) + help2 = v(1) + help3 = v(2) + x(1) = xgrid1 * Cos_alfaTgt - help1 * Sin_alfaTgt + x(2) = xgrid1 * Sin_alfaTgt + help1 * Cos_alfaTgt + v(1) = help2 * Cos_alfaTgt - help3 * Sin_alfaTgt + v(2) = help2 * Sin_alfaTgt + help3 * Cos_alfaTgt + endif + endif + +c - zerfallen? + + if (useDecay_) call Decay_Test(*555) + +c - falls aufgeschlagen: + + if (flag) goto 555 + +c - Koordinatentransformation zurueck in Beschleunigersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + x(1) = xGrid1 + x(3) = help1 + v(1) = help2 + v(3) = help3 + else + x(1) = xGrid1 + x(2) = help1 + v(1) = help2 + v(2) = help3 + endif + endif + +c - Datenausgabe: + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zweite Beschleunigerstufe: (homogenes Feld) + +2 Gebiet = upToGrid2 + steps = Steps + 1 + + if (a2.NE.0.) then + help1 = v(1)*v(1) + 2.*a2*(XGrid2-XGrid1) + if (help1.LT.0) then ! Reflektion noch vor 2. Gitter + dt = -2*v(1)/a2 + t = t + dt + !x(1) bleibt unveraendert + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/a2 + v(1) = v(1) + a2*dt + else + if (v(1).EQ.0) then ! (kann nur bei Start in 2. Stufe passieren) + write(*,*) + write(*,*)'ERROR: v(x) beim Start = 0. und '// + + 'Beschleunigung = 0' + write(*,*) + STOP + endif + dt = (XGrid2-XGrid1) / v(1) + endif + + t = t + dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + +c - Aufgeschlagen? + + if (Abs(x(2)).gt.dygrid2/2. .OR. + + Abs(x(3)).gt.dzgrid2/2.) then + flag = .true. + destiny = code_wand + else + flag = .false. ! <- noetig, falls Start auf 1. Gitter + endif + +c - Gitterstab getroffen? + + if (testOnWireHit) then + DrahtNr = nInt(x(2)/dist_Wires_G2) + distToWire(1) = 0 + distToWire(2) = x(2) - DrahtNr * dist_Wires_G2 + call Test_WireHit(distToWire,WireRadiusQuad_G2,v(1),v(2),WireHit) + if (WireHit) then + flag = .true. + destiny = code_grid + endif + endif + +c - Koordinatentransformation in Kammersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + x(1) = xgrid2 * Cos_alfaTgt - x(3) * Sin_alfaTgt + x(3) = xgrid2 * Sin_alfaTgt + x(3) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(3) * Sin_alfaTgt + v(3) = help1 * Sin_alfaTgt + v(3) * Cos_alfaTgt + else + x(1) = xgrid2 * Cos_alfaTgt - x(2) * Sin_alfaTgt + x(2) = xgrid2 * Sin_alfaTgt + x(2) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(2) * Sin_alfaTgt + v(2) = help1 * Sin_alfaTgt + v(2) * Cos_alfaTgt + endif + else + x(1) = xgrid2 + endif + +c - zerfallen? + + if (useDecay_) call Decay_Test(*555) + +c - falls aufgeschlagen: + + if (flag) goto 555 + +c - Datenausgabe: + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen zweitem Gitter und He-Shield: (feldfrei) + +3 Gebiet = upToHeShield + Steps = Steps + 1 + + radiusQuad = x(1)*x(1) + x(2)*x(2) + help1 = v(1)*v(1)+v(2)*v(2) + help2 = x(1)*v(1)+x(2)*v(2) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_HeShield))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen das Schild + x(3) = x(3) + dt*v(3) ! durchquert + + if (useDecay_) call Decay_Test(*555) + if (Abs(x(2)).gt.DYHESHIELD/2. .OR. + + Abs(x(3)).gt.DZHESHIELD/2.) then + destiny = code_wand + goto 555 + endif + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c Groessen bei x=40 mm berechnen: + + if (NTP_40mm) then + dt = (40-x(1))/v(1) + x40(2) = x(2)+v(2)*dt + x40(3) = x(3)+v(3)*dt + v40(1) = v(1) + v40(2) = v(2) + v40(3) = v(3) + t40 = t + dt + ! help1 = v(1)*v(1)+v(2)*v(2) noch bekannt von 'upToHeShield' + v_square = help1 + v(3)*v(3) + E40 = v_square * Energie_Faktor + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen He-Shield und LN-Shield: (feldfrei) + +4 Gebiet = upToLNShield + Steps = Steps + 1 + + radiusQuad = x(1)*x(1) + x(2)*x(2) + ! help1 = v(1)*v(1)+v(2)*v(2) ! noch bekannt von 'upToHeShield' + help2 = x(1)*v(1)+x(2)*v(2) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_LNShield))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen das Schild + x(3) = x(3) + dt*v(3) ! durchquert + + if (useDecay_) call Decay_Test(*555) + if (abs(x(2)).gt.dyLNShield/2. .OR. + + Abs(x(3)).gt.dzLNShield/2.) then + destiny = code_wand + goto 555 + endif + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen LN-Shield und Beginn der L1-Mappe: (feldfrei) + +5 Gebiet = upToL1Map + Steps = Steps + 1 + + dt = (xEnterMap_L1 - x(1)) / v(1) + + t = t + dt + x(1) = xEnterMap_L1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + if (radiusQuad.GT.radiusQuad_L1) then ! Teilchen fliegt an L1 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb L1: (inhom. Felder -> Integrationen) + +6 Gebiet = upToExL1 ! GebietsNummer fuer L1 setzen + +c Teste, ob das Teilchen ueberhaupt eine Beschleunigung erfaehrt (Spannung=0?, +c Ladung=0?). Falls nicht, steppe gleich bis zum Mappenende: + + if (Beschl_Faktor_L1.EQ.0) then +d dtmax_L1 = 0. +d dtmin_L1 = 0. + dt = (xLeaveMap_L1 - x(1)) / v(1) ! Zeit bis zum Mappenende + x(1) = xLeaveMap_L1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + goto 5106 + endif + +c............................................................................... +c Das Teilchen spuert eine Beschleunigung, es muss also integriert werden. +c Gehe als ersten Versuch 0.5 mm in das Gebiet hinein: + + dt = .5/v(1) + zaehler = 0 + +c............................................................................... +c hierher wird zurueckgesprungen, solange die Integration in der L1 bleibt + +5006 call INTEGRATIONSSTEP_RUNGE_KUTTA_L1(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_L1) then +d dtmin_L1 = dt +d x_dtmin_L1(1) = x(1) +d x_dtmin_L1(2) = x(2) +d x_dtmin_L1(3) = x(3) +d endif +d if (dt.GT.dtmax_L1) then +d dtmax_L1 = dt +d x_dtmax_L1(1) = x(1) +d x_dtmax_L1(2) = x(2) +d x_dtmax_L1(3) = x(3) +d endif +d endif + +c............................................................................... +5106 Steps = Steps + 1 ! neuer Ort, Zeit und Geschwindigkeit sind festgelegt + +c do some tests: + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_L1))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L1-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (x(1).LT.xEnterMap_L1) then + if (v(1).LT.0) then ! reflektiert? + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L1: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + STOP + endif + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + elseif (x(1).GE.xLeaveMap_L1) then ! Verlasse L1 + dt = (xLeaveMap_L1 - x(1))/v(1) ! rechne zurueck auf exaktes + t = t + dt ! Mappenende + x(1) = xLeaveMap_L1 + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + goto bis_Spiegel ! -> Mache bei upToEnSp weiter +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L1-2: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + endif + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5006 ! naechster Integrationsschritt in L1-Mappe + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen Linse 1 und Spiegel: (feldfrei) + +7 Gebiet = upToEnSp + Steps = Steps + 1 + +c - berechne Schnittpunkt mit forderer Spiegelebene: + + help2 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene + + if (help2.GE.Tan_alfaSp) then + ! Teilchen fliegt am Spiegel vorbei + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + if (useDecay_) call Decay_Test(*555) + destiny = code_vorbei + goto 555 + else + ! help1 == neues x(1) + help1 = (x(2) - y_intersectSP + xSpiegel*Tan_alfaSp + + - xLeaveMap_L1*help2) / (Tan_alfaSp - help2) + + dt = (help1-x(1)) / v(1) + t = t + dt + x(1) = help1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + endif + + if (useDecay_) call Decay_Test(*555) + if (Debug_) call Output_Debug + + +c Berechnung der Trajektorie bei idealem Spiegel: + + if (idealMirror) then ! ~~~ 40: if ~~~~~~~~~~~ + +c - pruefe, ob das Teilchen die ForderSEITE des Spiegels trifft: + + if ( x(2).GT.yUppLeft .OR. x(2).LT.yLowLeft .OR. + + abs(x(3)).GT.HSpiegel/2.) then + ! -> Teilchen fliegt am Spiegel vorbei + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_vorbei + goto 555 + endif + + +c - pruefe, ob das Teilchen einen Gitterstab des Spiegels trifft: + + if (testOnWireHit) then + help1 = x(2)-yLowLeft ! Abstand zum Bezugspunkt + DrahtNr = nInt(help1/(Sin_alfaSp*dist_Wires_Sp)) + distToWire(2) = help1 - DrahtNr * Sin_alfaSp*dist_Wires_Sp + distToWire(1) = distToWire(2)/Tan_alfaSp + call Test_WireHit(distToWire,WireRadiusQuad_Sp,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_grid + goto 555 + endif + endif + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c im Spiegel: (homogenes Feld) + +8 Gebiet = upToExSp + Steps = Steps + 1 + +c - pruefe, ob Teilchen nicht zuviel Energie senkrecht zum Spiegel hat: + + if (Spiegel_Faktor.EQ.0.) then ! Spannung=0. oder q=0 + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + ! help1 == Winkel in xy-Ebene zwischen Bewegungsrichtung und Spiegelfront + + help1 = alfaSp - atand(v(2)/v(1)) + + ! help2 = Geschw.Komponente senkrecht auf den Spiegel gerichtet + ! help3 = Geschw.Komponente parallel zum Spiegel, zu positiven y hin + + v_xy = sqrt( v(1)*v(1) + v(2)*v(2) ) + help2 = sind(help1) * v_xy + help3 = cosd(help1) * v_xy + + if (help2*help2*Energie_Faktor.GE.q*U_Sp) then + ! Teilchen tritt durch Spiegel durch + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + if (Graphics_) call Save_Graphics_Koord + + +c - berechne Zeit, bis Teilchen wieder auf Spiegelforderseite ist: + + dt = help2 * Spiegel_Faktor ! Spiegel_Faktor == 2 / a + t = t + dt + +c - berechne Versetzung in xy-Ebene, parallel zur Spiegelebene, +c in 'positiver y-Richtung' (speichere in 'help1'): + + help1 = help3*dt + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c falls Graphikausgabe verlangt ist: +c Um die Teilchenbahn im Innern des Spiegels anzudeuten, berechne die Orte bei +c t+dt/4, t+td/2 und t+3dt/4. Bestimme dafuer erst die jeweilige Versetzung +c senkrecht zur Spiegelebene aus dx = vx * t + 1/2 * a * t**2. +c (speichere in help4): + + if (Graphics_) then + + help4 = help2*dt*.25 - (dt*dt*.0625)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.25*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.25*Sin_alfaSp + zKoord(nKoord) = x(3) + v(3)*dt*.25 + + help4 = help2*dt*.50 - (dt*dt*.2500)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.50*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.50*Sin_alfaSp + zKoord(nKoord) = x(3)+v(3)*dt*.50 + + help4 = help2*dt*.75 - (dt*dt*.5625)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.75*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.75*Sin_alfaSp + zKoord(nKoord) = x(3)+v(3)*dt*.75 + + endif +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c - berechne Austrittsort: + + x(1) = x(1) + help1 * Cos_alfaSp + x(2) = x(2) + help1 * Sin_alfaSp + x(3) = x(3) + v(3)*dt + + +c - berechne Austrittsgeschwindigkeit (help2 geht bei Spiegelung in -help2 ueber): + + v(1) = help3 * Cos_alfaSp - help2 * Sin_alfaSp + v(2) = help2 * Cos_alfaSp + help3 * Sin_alfaSp + + if (v(2).LE.0) then + write(*,*) + write(*,*)'ERROR: nach Spiegel ist v(y) <= 0.' + write(*,*) + STOP + endif + + if (useDecay_) call Decay_Test(*555) + + +c - pruefe, ob Austrittspunkt auf forderer Spiegelflaeche liegt: + + if (x(2).GT.yUppLeft .OR. x(2).LT.yLowLeft .OR. + + abs(x(3)).GT.hSpiegel/2.) then + ! Teilchen trifft auf Spiegelwand + destiny = code_wand + goto 555 + endif + + +c - pruefe, ob das Teilchen einen Gitterstab des Spiegels trifft: + + if (testOnWireHit) then + help1 = x(2)-yLowLeft ! Abstand zum Bezugspunkt + DrahtNr = nInt(help1/(Sin_alfaSp*dist_Wires_Sp)) + distToWire(2) = help1 - DrahtNr * Sin_alfaSp*dist_Wires_Sp + distToWire(1) = distToWire(2)/Tan_alfaSp + call Test_WireHit(distToWire,WireRadiusQuad_Sp,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_grid + goto 555 + endif + endif + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + goto 9 + + endif ! ~~~ 40: endif ~~~~ + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der Spiegelmappe (dx = 0.050 mm, dy = 0.050 mm) + + Gebiet = upToExSp + nKoordSave = nKoord + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_Sp.EQ.0. .OR. q.EQ.0) then +d dtmax_Sp = 0. +d dtmin_Sp = 0. + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + dt = 0.5/v(1) + + reachedEndOfMap = .false. + zaehler = 0 + + +c Rechne in Spiegelmappen-Koordinaten um: +c Im Spiegelmappensystem: x-Achse verlaueft entlang der forderen Mappenkante, +c y-Achse aus dem Spiegel heraus. (entgegen der Richtung zunehmender Mappen- +c j-indizierung!) + + +5008 help1= x(1) - xSpiegel + x(1) = - x(2)*Cos_alfaSp + help1*Sin_alfaSp + + + (dSpiegel/2.+DreharmLaenge+xSpGrid1) + x(2) = x(2)*Sin_alfaSP + help1*Cos_alfaSP + help1= v(1) + v(1) = - v(2)*Cos_alfaSp + help1*Sin_alfaSp + v(2) = v(2)*Sin_alfaSP + help1*Cos_alfaSP + + +c mache Integrationsschritt: + + call INTEGRATIONSSTEP_RUNGE_KUTTA_Sp(dt) ! setzt u.U. auch 'destiny' + + Steps = Steps + 1 + + +c do some tests: + + if (Steps.GE.MaxStep) destiny = code_lost ! Teilchen verloren + + +c - Potentialmappe nach Reflektion wieder verlasssen? + + if (x(1).LT.0) then + reachedEndOfMap = .true. + +c - Spiegelrahmen getroffen? + + elseif (x(1).GE.xSpGrid1 .AND. + + (abs(x(2)).GT.bSpiegel/2. .OR. abs(x(3)).GT.hSpiegel/2.)) then + destiny = code_wand + +c - Gitterstab getroffen? + + else + help1 = min(abs(x(1)-xSpGrid1),abs(x(1)-xSpGrid1)) + if (help1.LE.rWires_Sp) then + DrahtNr = nInt(x(2)/dist_Wires_Sp) + distToWire(2) = x(2) - DrahtNr * dist_Wires_Sp + if ( (help1*help1 + distToWire(2)*distToWire(2)).LE. + + radiusQuad_Sp) destiny = code_grid + endif + + endif + +c if (destiny.NE.code_ok) then +c if (x(1).LT.xSpGrid1) then +c if (v(1).GT.0) then +c gebiet = UpToGrid +c else +c gebiet = upToExMap +c endif +c else +c gebiet = RetToGrid +c endif +c endif + + +c Rechne in Kammerkoordinaten zurueck: + + help1= x(1)-(dSpiegel/2.+DreharmLaenge+xSpGrid1) + x(1) = help1*Sin_alfaSP + x(2)*Cos_alfaSP + xSpiegel + x(2) = - help1*Cos_alfaSP + x(2)*Sin_alfaSP + help1= v(1) + v(1) = help1*Sin_alfaSP + v(2)*Cos_alfaSP + v(2) = - help1*Cos_alfaSP + v(2)*Sin_alfaSP + +d if (NTP_steps) then +d if (dt.LT.dtmin_Sp) then +d dtmin_Sp = dt +d x_dtmin_Sp(1) = x(1) +d x_dtmin_Sp(2) = x(2) +d x_dtmin_Sp(3) = x(3) +d endif +d if (dt.GT.dtmax_Sp) then +d dtmax_Sp = dt +d x_dtmax_Sp(1) = x(1) +d x_dtmax_Sp(2) = x(2) +d x_dtmax_Sp(3) = x(3) +d endif +d endif + + +c zerfallen? + + if (useDecay_) call Decay_Test(*555) + + +c Bahnberechnung abgebrochen? + + if (destiny.NE.code_ok) goto 555 + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (GRAPHICS_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + if (.NOT.reachedEndOfMap) goto 5008 ! naechster Integrationsschritt + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen Spiegel und Koordinatenwechsel-Ebene y=xChangeKoord: (feldfrei) + +9 Gebiet = upToChKoord + Steps = Steps + 1 + + if (x(2).LT.xChangeKoord) then + ! gegebenenfalls flag fuer Graphikausgabe des Punktes setzen + flag = .true. + else + flag = .false. + endif + + dt = (xChangeKoord - x(2)) / v(2) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = xChangeKoord + x(3) = x(3) + v(3)*dt + + help4 = x(1)-xSpiegel + radiusQuad = help4*help4 + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(1)*v(1)+v(3)*v(3) + help2 = help4*v(1)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_.AND.flag) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c falls Graphikausgabe verlangt ist: Gib jetzt die Trajektorie im 'horizontalen' +c Teil der Kammer aus und resette nKoord: + + if (Graphics_) then + + call plot_horizontal + if (schnitt_p.eq.1) call schnitt ! Schnittebene + + ! die letzten Koordinaten fuer Plot der Trajektorie im 2. Kammerteil + ! uebernehmen (in neues KoordinatenSystem transformiert): + + k = nKoord + + if (idealMirror) then + nKoord = 7 + else + if (nKoord.LT.nKoordSave) then + ! => ein 'turn over' fand statt waehrend das Teilchen in der + ! Spiegelmappe war => x(999) -> x(1), x(1000) -> x(2) + nKoord = nKoord + (999-nKoordSave) + else + nKoord = nKoord - nKoordSave + 1 + endif + nKoord = nKoord-2 + endif + + do i = nKoord, 1, -1 + xKoord_(i) = yKoord(k) + yKoord_(i) = xSpiegel - xKoord(k) + zKoord_(i) = zKoord(k) + k = k - 1 + if (k.EQ.0) then + k = 998 + endif + enddo + do i = 1, nKoord + xKoord(i) = xKoord_(i) + yKoord(i) = yKoord_(i) + zKoord(i) = zKoord_(i) + enddo + endif + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c - Vollziehe Koordinatenwechsel: neuer Ursprung in der Spiegelaufhaengung, +c x-Richtung in bisherige y-Richtung (also wiederum entlang Strahlachse), +c y-Richtung in bisheriger negativer x-Richtung. z-Richtung bleibt gleich. + + help1 = x(2) + x(2) = xSpiegel - x(1) + x(1) = help1 + help1 = v(1) + v(1) = v(2) + v(2) = - help1 + + if (Debug_) then + write (lun(1),*) 'KOORDINATENWECHSEL:' + call Output_Debug + endif + + +c Beruecksichtige gegebenenfalls die Flugzeit in 'delta_L1', welches 'vor dem +c Triggerdetektor' eingeschoben werden kann: + + dt = Delta_L1 / v(1) + x(1) = x(1)+v(1)*dt + x(2) = x(2)+v(2)*dt + x(3) = x(3)+v(3)*dt + t = t + dt + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + if (lense2) then ! ~~~~~~~~~~~~~~ ******* ~~~~~~~~~~~~~~~ + +c Bei 'lense2' wird fuer das Feld der Linse 2 und das Feld der TD-Folie eine +c gemeinsame Mappe verwendet. Hierbei ist allerdings der Triggerwinkel auf 0 +c Grad festgelegt. Da es in Zukunft in der Praxis wohl kaum noch vorkommen wird, +c dass der Triggerdetektor verdreht wird, sollte diese Einschraenkung jedoch +c keine grossen Auswirkungen haben. +c Ist der Triggerdetektor nicht im Strahl, so wird der Anteil der Triggerfolie +c gleich Null gesetzt. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c zwischen KOORDINATENWECHSEL und Beginn der L2andFo-Mappe: (feldfrei) + +10 Gebiet = upToL2andFoMap + Steps = Steps + 1 + + dt = (xEnterMap_L2andFo - x(1)) / v(1) + t = t + dt + x(1) = xEnterMap_L2andFo + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + if (radiusQuad.GT.radiusQuad_L2) then ! Teilchen fliegt an L2 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der gemeinsamen Mappe von Linse 2 und dem Feld vor der Trigger- +c Detektor-Folie: + +11 Gebiet = upToExL2 ! Gebietsnummer fuer L2 setzen + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor.EQ.0. .OR. (U_L2.EQ.0. AND. U_F.EQ.0.)) then +c WRITE(*,*) 'HALLOHALLO!' +d dtmax_L2andFo = 0. +d dtmin_L2andFo = 0. + dt = (xEndLense_L2 - x(1)) / v(1) ! Zeit bis zum Linsenende + x(1) = xEndLense_L2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L2) then + destiny = code_wand + radiusQuad_ = radiusQuad_L2 + goto 5111 + endif + if (TriggerInBeam) then + Gebiet = upToEnTD ! Gebietsnummer fuer upToTD setzen + ! Zeit bis zum Mappenende (falls TD im Strahl: bis Triggerfolie) + dt = (xLeaveMap_L2andFo - xEndLense_L2) / v(1) + x(1) = xLeaveMap_L2andFo + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + radiusQuad_ = radiusQuad_Rohr + endif + endif + goto 5111 + endif + + dt = .5/v(1) + zaehler = 0 + reachedEndOfMap = .false. + + +c die Integrationsroutine will x bereits relativ zum Mappenanfang geliefert +c bekommen: + +5011 x(1) = x(1) - xEnterMap_L2andFo + call INTEGRATIONSSTEP_RUNGE_KUTTA_L2(dt) + x(1) = x(1) + xEnterMap_L2andFo + +d if (NTP_steps) then +d if (dt.LT.dtmin_L2andFo) then +d dtmin_L2andFo = dt +d x_dtmin_L2andFo(1) = x(1) +d x_dtmin_L2andFo(2) = x(2) +d x_dtmin_L2andFo(3) = x(3) +d endif +d if (dt.GT.dtmax_L2andFo) then +d dtmax_L2andFo = dt +d x_dtmax_L2andFo(1) = x(1) +d x_dtmax_L2andFo(2) = x(2) +d x_dtmax_L2andFo(3) = x(3) +d endif +d endif + +5111 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_))-help2)/help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (Gebiet.EQ.upToExL2) then ! ----> noch innerhalb von Linse 2 + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L2) then + destiny = code_wand + radiusQuad_ = radiusQuad_L2 + goto 5111 + endif + + if (x(1).LT.xEnterMap_L2andFo) then + if (v(1).LT.0) then ! reflektiert + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L2: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + call exit + endif + elseif (x(1).GT.xEndLense_L2) then ! Verlasse L2 + Gebiet = upToEnTD + endif + + else ! ----> zw. Linse 2 und TD-Folie: + +c if (x(1).EQ.xLeaveMap_L2andFo) then ! Verlasse Mappe + if (reachedEndOfMap) then ! Verlasse Mappe + +c WRITE(*,*) 'HALLO: x(1).EQ.xLeaveMap_L2andFo !!' + ! ==================================================== + ! muss in Integrationsroutine richtig abgestimmt sein! + ! ==================================================== + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + if (TriggerInBeam) then + ! rechne in Triggerkoordinaten um (Folie == x=0) + x(1) = 0 + goto 112 + else + goto bis_L3_Mappe + endif + endif + + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + radiusQuad_ = radiusQuad_Rohr + goto 5111 + endif + + endif + + if (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5011 ! naechster Integrationsschritt in gleicher Feldmappe + + endif ! if (lense2) then.... ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + if (.NOT.TriggerInBeam) goto bis_L3_Mappe + + +c zwischen Koordinatenwechselebene und Triggerfolie: (feldfrei) +12 Gebiet = upToEnTD + +c Die Anweisungen dieses Abschnitts verlaufen in weiten Teilen parallel zu denen +c von Linse 1. -> Fuer Kommentare zu diesen Bereichen siehe dort! + + if (Beschl_Faktor_FO.EQ.0. .OR. gridInFrontOfFoil) then + ! => keine Integration in der Folienmappe + Steps = Steps + 1 + help1 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene +d dtmin_FO = 0. +d dtmax_FO = 0. + +c - berechne Schnittpunkt der Trajektorie mit Ebene der Triggerfolie bzw. bei +c 'GridInFrontOfFoil' mit Ebene des Gitters vor der Triggerfolie: +c Folienebene : y'= (x_intersectTD - x') / Tan_alfaTD +c Trajektorie : y'= y + v(2)/v(1)*(x'-x) = y + help1*(x'-x) +c => Schnittpunkt: x'= (x_intersectTD/Tan_alfaTD - y + help1*x)/(help1 + 1/Tan_alfaTD) +c = (x_intersectTD + Tan_alfaTD*(help1*x-y))/(1+help1*Tan_alfaTD) +c (erste Gleichung hat Probleme bei Tan_alfaTD = 0!) + + if (atand(help1).EQ.alfaTD-90) then ! ueberpruefen<<<<<<<<<<<<<<<<<< + ! Teilchen fliegt parallel zur Folie => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + else ! help2 == neues x(1) + if (Tan_alfaTD.EQ.0) then + dt = (x_intersectTD-x(1)) / v(1) + x(1) = x_intersectTD + else + help2 = (x_intersectTD+Tan_alfaTD* + + (help1*xChangeKoord-x(2)))/(1+help1*Tan_alfaTD) + if (help2.LT.xChangeKoord) then + ! Teilchen fliegt 'steiler' als Folienebene + ! -> kein Schnittpunkt mit dt.gt.0 => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + else ! Bahntangente kreuzt Folienebene + dt = (help2-x(1)) / v(1) + x(1) = help2 + endif + endif + endif + +c -> Teilchenort in Folienebene bzw. bei 'GridInFrontOfFoil' in Ebene des +c geerdeten Gitters vor der Triggerfolie: + + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + +c Koordinatentransformation vom Kammersystem in das System des Triggerdetektors: +c (Ursprung in Folienmitte, x-Achse senkrecht zur Folie, y-Achse parallel zur +c Folie. Wenn der TD nicht verdreht ist, verlaufen die Achsen parallel zu +c denen des Kammersystems): + + if (alfaTD.NE.0) then + x(2) = (xTD-x(1))*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + if (.NOT.GridInFrontOfFoil) then + x(1) = 0 + else + ! -> berechne Schnittpunkt der Trajektorie mit Folienebene unter + ! der Annahme einer idealen Potentialrampe: + + if (aFoil.NE.0.) then + help1 = v(1)*v(1) + 2.*aFoil*(d_Grid_Folie) + if (help1.LT.0) then ! Reflektion noch vor Folie + dt = -2*v(1)/aFoil + t = t + dt + x(1) = - d_Grid_Folie + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/aFoil + ! (ergibt sich aus x=v*t+1/2*a*t**2 mit richtiger V.Z.-Wahl ('+')) + v(1) = v(1) + aFoil*dt + else + dt = d_Grid_Folie / v(1) + endif + + t = t + dt + x(1) = 0 ! im Triggersystem + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + endif ! if (GridInFrontOfFoil) ... + + goto 112 + +c............................................................................... + else ! (if Beschl_Faktor_FO.EQ.0 .OR. GridInFrontOfFoil) then ... + + ! => Integration in der Folienmappe: + ! alte Version: ab xChangeKoord wurde integriert, wobei das EFeld im + ! Bereich vor der Mappe als 0 zurueckgegeben wurde. + ! Ab Version 1.2.9: Bis Schnittpunkt der Trajektorie mit Beginn der + ! Potentialmappe wird extrapoliert, dann erst integriert: + + +c Einschub ab Version 1.2.9: *************************************************** + + Steps = Steps + 1 + help1 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene + +c - berechne Schnittpunkt der Trajektorie mit Beginn der Potentialmappe: +c Mappenebene : y'= (x_intersectTDMap - x') / Tan_alfaTD +c Trajektorie : y'= y + v(2)/v(1)*(x'-x) = y + help1*(x'-x) +c => Schnittpunkt: x'= (x_intersectTDMap/Tan_alfaTD - y + help1*x)/(help1 + 1/Tan_alfaTD) +c = (x_intersectTDMap + Tan_alfaTD*(help1*x-y))/(1+help1*Tan_alfaTD) +c (erste Gleichung hat Probleme bei Tan_alfaTD = 0!) + + if (atand(help1).EQ.alfaTD-90) then ! ueberpruefen<<<<<<<<<<<<<<<<<< + ! Teilchen fliegt parallel zur Mappe => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + + ! stimmt so u.U. noch nicht ganz. Kommt aber eigentlich eh nie vor! + ! (stimmt bis jetzt wohl nur fuer positive alpha(TD) + + else + if (Tan_alfaTD.EQ.0) then + dt = (x_intersectTDMap-x(1)) / v(1) + x(1) = x_intersectTDMap + else + ! help2 == neues x(1): + help2 = (x_intersectTDMap+Tan_alfaTD* + + (help1*xChangeKoord-x(2)))/(1+help1*Tan_alfaTD) + ! folgendes herauskommentiert, da es teilweise passierte, dass + ! der Mappenanfang ueber xChangekoord hinausreichte und die + ! Trajektorien dann faelschlicherweise abgebrochen worden sind. + +c if (help2.LT.xChangeKoord) then +c ! Teilchen fliegt 'steiler' als Mappenebene +c ! -> kein Schnittpunkt mit dt.gt.0 => fliegt an TD vorbei +c destiny = code_vorbei +c goto 555 +c else ! Bahntangente kreuzt Mappenebene + dt = (help2-x(1)) / v(1) + x(1) = help2 +c endif + endif + endif + +c -> Teilchenort in Mappenebene: + + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c Ende des Einschubes ab Version 1.2.9: **************************************** +c => Jetzt erfolgt Start in die Folienmappe: + + reachedEndOfMap = .false. ! Folienebene wurde noch nicht erreicht + dt = .5/v(1) ! 1. Testschritt 0.5 mm in x-Richtung + zaehler = 0 + + +c Rechne in Folienmappen-Koordinaten um: + +5012 if (alfaTD.NE.0) then + help1= x(1)-xTD + x(1) = help1*Cos_alfaTD + x(2)*Sin_alfaTD + length1 + x(2) = -help1*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTd + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTd + else + x(1) = x(1) - length2 + endif + + +c mache Integrationssschritt: + + call INTEGRATIONSSTEP_RUNGE_KUTTA_FO(dt) + +d if (NTP_steps) then +d if (dt.LT.dtmin_FO) then +d dtmin_FO = dt +d x_dtmin_FO(1) = x(1) +d x_dtmin_FO(2) = x(2) +d x_dtmin_FO(3) = x(3) +d endif +d if (dt.GT.dtmax_FO) then +d dtmax_FO = dt +d x_dtmax_FO(1) = x(1) +d x_dtmax_FO(2) = x(2) +d x_dtmax_FO(3) = x(3) +d endif +d endif + + +c Rechne in Kammerkoordinaten zurueck: + + if (alfaTD.NE.0) then + help1= x(1)-length1 + x(1) = help1*Cos_alfaTD - x(2)*Sin_alfaTD + xTD + x(2) = help1*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + length2 + endif + + Steps = Steps + 1 ! neuer Ort, Zeit und Geschwindigkeit sind festgelegt + +c do some tests: + + if (destiny.EQ.code_dtSmall) then ! n_dtSmall>maxBelowDtSmall + goto 555 + endif + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then ! aufgeschlagen + help1 = v(2)*v(2)+v(3)*v(3) ! -> den Ort berechnen, an + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (destiny.EQ.code_reflektiert) then ! reflektiert + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'FO-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + if (reachedEndOfMap) then ! Folienebene erreicht + ! rechne in Triggerkoordinaten um (Folie == x=0) + if (alfaTD.NE.0) then + x(2) = (xTD-x(1))*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + x(1) = 0 + goto 112 + endif + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5012 ! naechster Integrationsschritt in FELD VOR FOLIE + +c............................................................................... + endif ! (if Beschl_Faktor_FO.EQ.0) then ... + +c Einsprunglabel fuer Starts auf der Triggerfolie mit Startwinkelangaben +c im Kammersystem => transformiere Geschwindigkeitsvektor in das Triggersystem: + +111 if (alfaTD.NE.0) then + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + +c - pruefe, ob das Projektil die Folie trifft: + +112 radiusQuad = x(2)*x(2) + x(3)*x(3) + If (radiusQuad.GT.radiusQuad_Folie) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + destiny = code_vorbei + goto 555 + endif + + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das 'FoilFile': +c (hier ist sichergestellt, dass die Folie getroffen worden ist, Wechsel- +c wirkungen mit der Folie wurden aber noch nicht beruecksichtigt). +c HIER WERDEN 'X' UND 'V' IM TRIGGERSYSTEM ABGESPEICHERT! + + if (createFoilFile) then + ! falls die Flugzeit bis zur Triggerfolie verschmiert in das + ! NTupel aufgenommen werden soll: + if (smearS1Fo) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = t + help4 + endif + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + call HFNT(NTP_write) + NTPalreadyWritten = .true. + endif + + +c - Zeitpunkt bei Erreichen der Folie sichern: + +113 S1Fo = t + if (createNTP.AND.Fo_triggered) fill_NTP = .true. + if (statNeeded(Nr_S1Fo)) call fill_statMem(S1Fo,Nr_S1Fo) + + + +c - Speichern der Koordinaten fuer die Statistiken: + + if (statNeeded(Nr_y_Fo)) then + call fill_statMem( x(2),Nr_y_Fo) + endif + if (statNeeded(Nr_z_Fo)) then + call fill_statMem( x(3),Nr_z_Fo) + endif + if (statNeeded(Nr_r_Fo)) then + radius = SQRT(x(2)*x(2) + x(3)*x(3)) + call fill_statMem(radius,Nr_r_Fo) + endif + + +c - speichere Auftreffort des Projektils fuer die Berechnung der Folienelektronen: + + if (generate_FE) then + x0FE(1) = x(1) + x0FE(2) = x(2) + x0FE(3) = x(3) + endif + + +c - falls nur bis zur Folie gerechnet werden soll, beende hier die Integration: + + if (upToTDFoilOnly) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + if (generate_FE) Gebiet = UpToExTD + goto 555 + endif + + +c - pruefe, ob das Projektil auf das Stuetzgitter aufschlaegt: + + if (testOnWireHit .AND. ran(seed).GT.TransTDFoil) then + destiny = code_Stuetzgitter + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + goto 555 + endif + + +c - Energieverlust und Winkelaufstreuung: + + if (log_E_Verlust .OR. log_Aufstreu) then + if (Debug_) then + Steps = Steps + 1 + call Output_Debug + endif + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + v_Betrag = SQRT(v_square) + Ekin = v_square * Energie_Faktor + endif + +c -- Energieverlust (vorerst nur Gaussverteilt): + + if (log_E_Verlust_defined.OR.log_Meyer_Gauss) then + ! Berechne Bahnwinkel relativ zur Folienebene fuer effektive Folien- + ! dicke: + alfa = atand(SQRT(v(2)*v(2)+v(3)*v(3))/v(1)) + endif + + if (log_E_Verlust) then + if (calculate_each) then + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,E_Verlust) + else + E_Verlust = mean_E_Verlust + endif + if (log_E_Verlust_defined) E_Verlust = E_Verlust / cosd(alfa) + if (debug_) write (lunLOG,*) ' mittlerer Energieverlust: ',E_Verlust + + ! Now we have the mean energy loss. We still have to modify it + ! according to the distribution of energy losses, i.e. + ! E_Verlust -> E_Verlust + delta_E_Verlust: + + delta_E_Verlust = 0. + if (log_E_Straggling_sigma) then +400 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 400 + elseif (log_E_Straggling_equal) then +410 delta_E_Verlust = lowerE + (upperE - lowerE)*ran(seed) + if (E_Verlust+delta_E_Verlust.LT.0) goto 410 + elseif (log_E_Straggling_Lindhard) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie: + call E_Straggling_Lindhard(Ekin-0.5*E_Verlust,m,sigmaE) +420 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 420 + elseif (log_E_Straggling_Yang) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie! + call E_Straggling_Yang(Ekin-0.5*E_Verlust,m,sigmaE) +430 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 430 + endif + + if (E_Verlust+delta_E_Verlust.GE.Ekin) then + destiny = code_stopped_in_foil + goto 555 + endif + E_Verlust = E_Verlust + delta_E_Verlust + + ! help1 == Reduzierungsfaktor fuer Geschw.Betrag + help1 = sqrt( (Ekin - E_Verlust)/Ekin ) + v(1) = help1 * v(1) + v(2) = help1 * v(2) + v(3) = help1 * v(3) + v_Betrag = help1 * v_Betrag + if (debug_) write (lunLOG,*) ' Energieverlust: ',E_Verlust + endif + +c -- Winkelaufstreuung (vorerst nur Gaussverteilt): + + if (log_aufstreu) then + if (log_Meyer_F_Function) then + call throwMeyerAngle(thetaAufstreu) + else + if (log_Meyer_Gauss) then + if (log_E_Verlust) Ekin = Ekin - .5 * E_Verlust ! mittlere Energie + effRedThick = Meyer_Faktor1 * Thickness / cosd(alfa) + call g_Functions(g1,g2,effRedThick) + sigmaAufstreu = Meyer_Faktor2 / Ekin * (g1 + Meyer_Faktor3*g2) + if (debug_) then + write (lunLOG,*) ' effekt. red. Dicke: ',effRedThick + write (lunLOG,*) ' Sigma(Streuwinkel): ',sigmaAufstreu + endif + endif + + call Gauss_Verteilung_theta(sigmaAufstreu,thetaAufstreu) + endif + + st0 = sind(thetaAufstreu) + ct0 = cosd(thetaAufstreu) + phiAufstreu = 360.*ran(seed) + + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) ! v_xy stets groesser 0 + ! wegen v(1)>0 + + help1 = v(1) + help2 = v(2) + help3 = v_Betrag*st0*cosd(phiAufstreu)/v_xy + help4 = st0*sind(phiAufstreu) + + v(1) = ct0*help1 - help3*help2 - help4*help1*v(3)/v_xy + v(2) = ct0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = ct0*v(3) + help4*v_xy + if (debug_) write (lunLOG,*) ' Aufstreuung: theta, phi =', + + thetaAufstreu,phiAufstreu + endif + + if (Debug_ .AND. (log_E_Verlust .OR. log_Aufstreu)) then + call Output_Debug + endif + + +c - Neutralisierung in der Folie? + + if (log_neutralize) then + if (neutral_fract(q_).EQ.-1.0) then + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + Ekin = v_square * Energie_Faktor + call chargeStateYields(Ekin,m,YieldPlus,YieldNeutral) + YieldNeutral = 100. * YieldNeutral + else + YieldNeutral = neutral_fract(q_) + endif + if (100.*ran(seed).LE.YieldNeutral) then + q = 0. + qInt = 0 + if (debug_) then + write (lunLOG,*) ' Teilchen wurde neutralisiert' + endif + nNeutral = nNeutral + 1 + else + nCharged = nCharged + 1 + endif + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c im TriggerDetektor: (homogene Felder) + + +13 Gebiet = upToExTD + Steps = Steps + 1 + +c der Weg des Projektils innerhalb der Triggerkammer: + + call TRIGGER(m,q,t,x,v,Debug_,graphics_,n_return) + + +c Koordinatentransformation vom System des Triggerdetektors in das Kammersystem: +c ('d_Achse_Ground' == Abstand zwischen TD-Achse und 'Ground'-Gitter) + + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + +c Was ist im TD mit dem Teilchen passiert? + + if (n_return.NE.0) then ! -->> das Projektil kam nicht bei GROUND an + if (n_return.GT.100 .AND. n_return.LE.120) then ! -> abgebrochen + statTD(1,n_return-100) = statTD(1,n_return-100)+1 ! Grund notieren + destiny = code_lostInTD ! im TD verloren + elseif (n_return.GT.0..AND.n_return.LE.75) then ! -> pfosten getroffen! + pfostenHit(n_return,1) = pfostenHit(n_return,1)+1 + destiny = code_wand + elseif (n_return.EQ.-5) then ! -> im TD auf Gitterstab + statTD(1,17) = statTD(1,17)+1 ! + destiny = code_grid + elseif (n_return.EQ.-9) then ! -> NICHT im MCP3 registriert + statTD(1,18) = statTD(1,18)+1 ! + destiny = code_notRegInM3 + elseif (n_return.EQ.-10) then ! -> im MCP3 registriert + statTD(1,16) = statTD(1,16)+1 ! '16' zaehlt MCP3-Treffer + destiny = code_wand + endif + goto 555 ! naechstes Projektil + else ! -->> das Projektil kam bei GROUND an + statTD(1,15) = statTD(1,15)+1 ! '15' zaehlt GROUND-Treffer + endif + + if (useDecay_) call Decay_Test(*555) + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen KOORDINATENWECHSEL BZW. GROUND-GITTER und Beginn der L3-Mappe: +c (feldfrei) + +14 Gebiet = upToL3Map + Steps = Steps + 1 + + dt = (xEnterMap_L3 - x(1)) / V(1) + t = t + dt + x(1) = xEnterMap_L3 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + if (radiusQuad.GT.radiusQuad_L3) then ! Teilchen fliegt an L3 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb L3: (inhom. Felder -> Integrationen) + + +15 Gebiet = upToExL3 ! Gebietsnummer fuer L3 setzen + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_L3.EQ.0. .OR. q.EQ.0) then ! q=0 -> in Folie neutralisiert +d dtmax_L3 = 0. +d dtmin_L3 = 0. + dt = (xLeaveMap_L3 - x(1)) / v(1) ! Zeit bis zum Mappenende + x(1) = xLeaveMap_L3 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L3) destiny = code_wand + goto 5115 + endif + + dt = .5/v(1) + zaehler = 0 + +5015 call INTEGRATIONSSTEP_RUNGE_KUTTA_L3(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_L3) then +d dtmin_L3 = dt +d x_dtmin_L3(1) = x(1) +d x_dtmin_L3(2) = x(2) +d x_dtmin_L3(3) = x(3) +d endif +d if (dt.GT.dtmax_L3) then +d dtmax_L3 = dt +d x_dtmax_L3(1) = x(1) +d x_dtmax_L3(2) = x(2) +d x_dtmax_L3(3) = x(3) +d endif +d endif + +5115 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_L3))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L3-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (x(1).LT.xEnterMap_L3) then + if (v(1).LT.0) then ! reflektiert? + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L3: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + STOP + endif + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + elseif (x(1).GE.xLeaveMap_L3) then ! Verlasse L3 + dt = (xLeaveMap_L3 - x(1))/v(1) ! rechne zurueck auf exaktes + t = t + dt ! Mappenende + x(1) = xLeaveMap_L3 + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + goto bis_MCP2_Mappe +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L3-2: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5015 ! naechster Integrationsschritt in gleicher Feldmappe + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen L3-Mappe und MCP2-Mappe (feldfrei) + + +16 Gebiet = upToM2Map + + if (x(1).EQ.xEnterMap_M2) goto MCP2_Mappe + Steps = Steps + 1 + + dt = (xEnterMap_M2 - x(1)) / v(1) + + t = t + dt + x(1) = xEnterMap_M2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c vor MCP2: (inhom. Felder -> Integrationen) + +17 Gebiet = upToMCP2 + +c Beruecksichtige gegebenenfalls die Flugzeit in 'delta_L2', welches 'vor dem +c MCP2' eingeschoben werden kann. Addiert wird vorerst nur die Flugzeit in +c dieser zusaetzlichen Flugstrecke. Korrekterweise muessten alle nachfolgenden +c Positionen um 'delta_L2' verschoben werden. Dies zu implementieren ist +c allerdings momentan aus Zeitgruenden nicht moeglich. + + dt = Delta_L2 / v(1) + t = t + dt + + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_M2.EQ.0. .OR. q.EQ.0) then ! q=0 -> in Folie neutralisiert +d dtmax_M2 = 0. +d dtmin_M2 = 0. + if (xBlende.GT.x(1)) then + dt = (xBlende - x(1)) / v(1) ! Zeit bis zur Blende + x(1) = xBlende + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + elseif (radiusQuad.GE.radiusQuad_Blende) then + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_hitBlende + goto 555 + endif + endif + dt = (xMCP2 - x(1)) / v(1) ! Zeit bis MCP2 + x(1) = xMCP2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) destiny = code_wand + reachedEndOfMap = .true. + goto 5117 + endif + + dt = .5/v(1) + + reachedEndOfMap = .false. + zaehler = 0 + if (xBlende.GT.0) check_Blende = .true. + +5017 call INTEGRATIONSSTEP_RUNGE_KUTTA_M2(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_M2) then +d dtmin_M2 = dt +d x_dtmin_M2(1) = x(1) +d x_dtmin_M2(2) = x(2) +d x_dtmin_M2(3) = x(3) +d endif +d if (dt.GT.dtmax_M2) then +d dtmax_M2 = dt +d x_dtmax_M2(1) = x(1) +d x_dtmax_M2(2) = x(2) +d x_dtmax_M2(3) = x(3) +d endif +d endif + +5117 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (check_Blende.AND.x(1).GE.xBlende) then + dt = (xBlende - x(1)) / v(1) ! zurueck zur Blende ... + x(1) = xBlende + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GE.radiusQuad_Blende) then + destiny = code_hitBlende + goto 555 + endif + dt = -dt ! ... wieder zum aktuellen Ort + x(1) = xBlende + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + check_Blende = .false. + elseif (destiny.EQ.code_wand) then + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (destiny.EQ.code_reflektiert) then ! reflektiert + goto 555 + elseif (reachedEndOfMap) then ! MCP2-Ebene erreicht +c if (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'M2 ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP +c endif + if (createNTP.AND.xM2_triggered) fill_NTP = .true. + S1xM2 = t + if (statNeeded(Nr_S1xM2))call fill_statMem(S1xM2,Nr_S1xM2) + radiusQuad = x(2)*x(2) + x(3)*x(3) + radius = SQRT(radiusQuad) + if (statNeeded(Nr_y_xM2)) call fill_statMem( x(2),Nr_y_xM2) + if (statNeeded(Nr_z_xM2)) call fill_statMem( x(3),Nr_z_xM2) + if (statNeeded(Nr_r_xM2)) call fill_statMem(radius,Nr_r_xM2) + if (radiusQuad.LE.radiusQuad_MCP2active) then + S1M2 = t ! Zeiten werden sowohl fuer Statistiken + FoM2 = t - S1Fo ! als auch fuer NTupel benoetigt + if (statNeeded(Nr_S1M2)) call fill_statMem(S1M2,Nr_S1M2) + if (statNeeded(Nr_FoM2)) call fill_statMem(FoM2,Nr_FoM2) + if (createNTP.AND.M2_triggered) fill_NTP = .true. + if (statNeeded(Nr_y_M2)) call fill_statMem( x(2),Nr_y_M2) + if (statNeeded(Nr_z_M2)) call fill_statMem( x(3),Nr_z_M2) + if (statNeeded(Nr_r_M2)) call fill_statMem(radius,Nr_r_M2) + else ! am MCP2 vorbei + if (radiusQuad.LE.radiusQuad_MCP2) then + destiny = code_hitMCP2inactive + else + destiny = code_vorbei + if (Graphics_) then ! Damit diese Trajektorie 40mm ueber die + nKoord = nKoord + 1 ! MCP2-Ebene hinausgezeichnet wird + dt = 40./v(1) + t = t + dt + xKoord(nKoord) = x(1)+40. + yKoord(nKoord) = x(2)+v(2)*dt + zKoord(nKoord) = x(3)+v(3)*dt + goto 556 + endif + endif + endif + + goto 555 + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5017 ! naechster Integrationsschritt im Feld vor MCP2 + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER IST DER PROGRAMMKODE FUER DIE TRAJEKTORIENBERECHNUNG +c DER PROJEKTILE BEENDET! +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +555 if (Graphics_) call Save_Graphics_Koord +556 if (Debug_) call Output_Debug + + +c Gib Trajektorie in Graphikfenster aus: + + if (Graphics_) then + if (Gebiet.LE.upToChKoord) then ! Bahnberechnung wurde vor + call plot_horizontal ! Koordinatenwechsel abgebrochen + if (schnitt_p.eq.1) call schnitt + else + call plot_vertikal + if (schnitt_p.eq.2) call schnitt + endif + nKoord = 0 + endif + + +c Pruefe, ob Teilchen reflektiert wurde: + + if ((Gebiet.EQ.upToExL1 .OR. Gebiet.EQ.upToEnTD .OR. + + Gebiet.EQ.upToExL3 .OR. Gebiet.EQ.upToMCP2) .AND. + + v(1).LE.0.) then + destiny = code_reflektiert + endif + + +c Zaehle mit, bei wie vielen Teilchen trotz dtMaxStep abgebrochen werden: + + if (destiny.EQ.code_lostInTD) then + lostInTD_counter = lostInTD_counter + 1 + elseif (destiny.EQ.code_lost) then + lost_counter = lost_counter + 1 + endif + + +c bei DEBUG: Ausgabe des Teilchenschicksals und des aktuellen Gebiets: + + if (debug_) then + indx = index(code_text(destiny),':') + if (indx.EQ.0) then + write(lun(1),*) 'destiny : ',code_text(destiny) + else + write(lun(1),*) 'destiny : ',code_text(destiny)(1:indx-1) + endif + indx = index(Gebiet_text(Gebiet),':') + if (indx.EQ.0) then + write(lun(1),*) 'Gebiet : ',Gebiet_text(Gebiet) + else + write(lun(1),*) 'Gebiet : ',Gebiet_text(Gebiet)(1:indx-1) + endif + endif + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER STARTEN DIE FOLIENELEKTRONEN +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + if (generate_FE) then ! ~~~ 1: if ~~~~~~~~~~~~ + if (Gebiet.GE.UpToExTD) then ! ~~~ 2: if ~~~~~~~~~~~~ + +c sekundaerelektronen + nFE = int(4.*ran(seed))+2 ! Anzahl wuerfeln: [2,5] + tFE_min = 0. ! tFE_min: kuerzeste FE-Flugzeit: + ! bekam noch keinen Wert zugewiesen + +c - die Laufzeiten der Folienelektronen: + + do 450, k = 1, nFE + + xFE(1) = x0FE(1) + xFE(2) = x0FE(2) + xFE(3) = x0FE(3) + + E0FE = 0.003*ran(seed) ! Start-Energie wuerfeln: [0,3) eV + v_Betrag = sqrt(2.*E0FE/511.015)*c ! Startgeschwindigkeit + call Lambert_Verteilung(1.,ct0,st0) ! Startwinkel wuerfeln + f0 = 360.*ran(seed) + cf0 = cosd(f0) + sf0 = sind(f0) + vFE(1) = v_Betrag * ct0 ! Geschwindigkeitskomponenten + vFE(2) = v_Betrag * st0*cf0 + vFE(3) = v_Betrag * st0*sf0 + + tFE = 0. + + nKoord = 0 + start_nr(2) = start_nr(2) + 1 ! (2): FE + call TRIGGER(511.015,-1.,tFE,xFE,vFE,DEBUG_FE.AND.Debug_, + + plot_FE,n_return) + if (plot_FE) call plot_vertikal + + if (n_return.NE.-10) then +C - das FE kam nicht am MCP3 an -> + if (n_return.GT.100 .AND. n_return.LE.120) then ! -> abgebrochen + statTD(2,n_return-100) = statTD(2,n_return-100)+1 ! Grund notieren + elseif (n_return.GT.0 .AND. n_return.LE.75) then ! -> pfosten getroffen! + pfostenHit(n_return,2) = pfostenHit(n_return,2)+1 + elseif (n_return.EQ.0) then ! -> GROUND getroffen + statTD(2,15) = statTD(2,15)+1 ! '15' zaehlt GROUND-Treffer + elseif (n_return.EQ.-5) then ! -> im TD auf Gitterstab + statTD(2,17) = statTD(2,17)+1 + elseif (n_return.EQ.-9) then ! -> NICHT im MCP3 registriert + statTD(2,18) = statTD(2,18)+1 + endif + tFE_(k) = -1 ! -1: FE kam nicht bei MCP3 an + goto 450 ! naechstes FE + + endif + +c - das FE kam beim MCP3 an -> + + statTD(2,16) = statTD(2,16)+1 ! '16' zaehlt MCP3-Treffer + tFE_(k)=int(1000.*tFE) ! tFE in ps. (braucht als Integer + ! weniger Speicherplatz) + + +c fuer die Statistik: die Flugzeiten saemtlicher das MCP3 erreichender FE abspeichern: + + if (statNeeded(Nr_t_FE)) call fill_statMem(tFE,Nr_t_FE) + + +c kuerzeste Elektronenflugzeit fuer das aktuelle Projektilteilchen notieren: + + if (tFE_min.EQ.0. .OR. tFE.LT.tFE_min) tFE_min = tFE + + +450 continue ! -> naechstes Folienelektron + + +c die Flugzeiten der nicht gestartenen Folienelektronen (nFE+1 bis 5) auf 0. setzen: + + do while (nFE.LT.5) + nFE = nFE + 1 + tFE_(nFE) = 0. + enddo + + +c Jetzt sind die Folienelektronen durchgelaufen. + +c Fuelle Statistiken fuer die 'gemessenen' Teilchenflugzeiten (mit Beruecksichti- +c gung der Flugzeiten der Folienelektronen). M3M2 aber nur, wenn MCP2 auch +c getroffen wurde: + + if (tFE_min.NE.0.) then + S1M3 = S1Fo + tFE_min ! +, da Stop verzoegert + if (statNeeded(Nr_S1M3)) then + call fill_statMem(S1M3,Nr_S1M3) + endif + if (destiny.EQ.code_ok) then + M3M2 = FoM2 - tFE_min ! -, da Start verzoegert + if (statNeeded(Nr_M3M2)) call fill_statMem(M3M2,Nr_M3M2) + endif + endif + + else ! ~~~ 2: else ~~~~~~~~~~ + + do k= 1, 5 + tFE_(k) = 0. ! nicht gestartet + enddo + + endif ! ~~~ 2: endif ~~~~~~~~~ + endif ! ~~~ 1: endif~~~~~~~~~~ + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c ES FOLGEN DATENAUSGABE, SPRUNG IN NEUE SCHLEIFE UND PROGRAMMENDE +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c trage das NTupel ein: + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das NTupel: +c (falls bei 'createFoilFile' 'NTPalreadyWritten' nicht gesetzt ist schied +c dieses Teilchen schon vor der Triggerfolie aus. Ist es dagegen gesetzt wurden +c die Trajektoriendaten mit dem Erreichen der Triggerfolie abgespeichert um sie +c in den im Triggersystem gueltigen Werten zu haben): + + if (fill_NTP .OR. createFoilFile) then + if (NTPalreadyWritten) then + NTPalreadyWritten = .false. + else + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + if (smearS1Fo .AND. .NOT.use_MUTRACK) then + if (s1fo.NE.0) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = S1Fo + help4 + else + S1FoOnly = 0. + endif + endif + FoM2Only = FoM2 + call HFNT(NTP_write) + endif + endif + + +c Nimm das Schicksal des Teilchens in den zugehoerigen Statistikspeicher auf: + + if (destiny.GT.0) destiny = destiny + (Gebiet-1)*highest_code_Nr + statDestiny(destiny) = statDestiny(destiny) + 1 + + if (destiny.EQ.code_ok) okStepsCounter = okStepsCounter + steps + + +c -> das naechste Projektil kann kommen +100 continue + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Jetzt sind alle Projektile dieser Schleife abgearbeitet! + +c Mittlere Anzahl an Integrationsschritten fuer Trajektorien mit destiny = +c 'code_ok' ausgeben: + + if (statDestiny(code_ok).NE.0) then + write(*,'(6x,A,F7.2)')'Mittlere Anzahl an Integrationsschritten bis zum Ziel: ', + + real(okStepsCounter)/real(statDestiny(code_ok)) + endif + +c das Summary ausgeben und die Werte in die Tabellen schreiben: +c Falls nur ein Teilchenstart pro Schleife erfolgt, werte die Statistiken +c erst nach der letzten Schleife aus: + + NotLastLoop = .NOT.(SchleifenNr.EQ.SchleifenZahl) + flag_ok = .NOT.(OneStartPerLoop.AND.NotLastLoop) + + if (flag_ok) then + call eval_statistics + if (n_outWhere.GT.0 .OR. smallLogFile) call Summary + if (createTabellen .or. createPhysTab) call output_tabellen + endif + + +c das PostScript-file erstellen: + +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Das Postskript braucht dann also erst bei der letzten Schleife +c erstellt zu werden: + + if (GRAPHICS .AND. flag_ok) then + call schnitt_plot ! Ausgabe der Graphik der Schnittebene + + if (n_postSkript.LE.0) then + goto 620 + elseif (n_postSkript.EQ.1) then + if (n_outWhere.LT.2) then + write(*,*)'.....................................'// + + '.........................................' + write(*,'(2X,A18,I3,A,I3)')'Schleife ', + + SchleifenNr,' von ',SchleifenZahl + endif + write(*,1003)'(P) Ps-file erstellen', + + '(R) Restliche ps-files erstellen' + write(*,1003)'(N) ps-file Nicht erstellen', + + '(K) Keine ps-files mehr erstellen' + write(*,1003)'(G) Graphikausgabe beenden', + + '(A) programm Abbrechen' +1003 format(T6,A,T40,A) + + helpChar = 'n' +600 write(*,1004)' [RETURN] = (N) -> ' +1004 format($,x,A) + read(*,'(A)') helpChar + + do i = 1,7 ! bis zu sechs blanks werden akzeptiert + ant = helpChar(i:i) + if (ant.NE.' ') goto 610 + enddo + ant = 'N' + +610 write(*,*)'==========================='// + + '=====================================================' + + call str$upcase(ant,ant) + if (ant.EQ.'N') then + goto 620 + elseif (ant.EQ.'R') then + n_postSkript = 2 + elseif (ant.EQ.'K') then + n_postSkript = 0 + goto 620 + elseif (ant.EQ.'G') then + call HPLEND + GRAPHICS = .false. + goto 200 + elseif (ant.EQ.'A') then + call HPLEND + call TERMINATE_OUTPUT + STOP + elseif (ant.NE.'P') then + goto 600 + endif + endif + + write (helpChar(1:7),'(''_'',I6)') SchleifenNr + if (filename.NE.' ') then + call MAKE_PS(filename//helpChar) + else + call MAKE_PS('MUTRACK'//helpChar) + endif + + +620 continue + + CALL IZPICT ('CHAM_1','S') ! LOESCHEN DER BILDER IM PAWC-COMMON-BLOCK + CALL IZPICT ('CHAM_2','S') + CALL IZPICT ('HISTO','S') + CALL IZPICT ('TEXT','S') + + call iclrwk (1,flag_ok) ! CLEAREN DER WORKSTATIONS + call iclrwk (3,flag_ok) + call iclrwk (4,flag_ok) + call iclrwk (5,flag_ok) + + CALL HRESET (50,' ') ! RESETTEN DES HISTOGRAMMS + + endif + +c -> das gleiche von vorne mit neuen Settings (d.h. neue Schleife) + +200 continue +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Jetzt sind alle Schleifen abgearbeitet -> fertigmachen zum Programmende: + +c - HIGZ-Graphikbibliothek schliessen: + + if (Graphics) call HPLEND + +c - HBOOK-Datei schliessen: + + if (.NOT.fromScratch) then + if (use_ACCEL) then + call HREND('ACCEL') + elseif (Use_MUTRACK) then + call HREND('MUread') + endif + close (lunRead) + endif + + call TERMINATE_OUTPUT + + + END + + +C=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Lambert_Verteilung(n_Lambert,cos_theta,sin_theta) +c ============================================================ + + IMPLICIT NONE + + real cos_theta,sin_theta + + real n_Lambert ! Ordnung der Lambert-Verteilung + real randomVar + integer seed + common /seed/ seed + + randomVar = ran(seed) + + if (n_Lambert.EQ.0.) then + cos_theta = (1.-randomVar) + sin_theta = sqrt(1.-cos_theta*cos_theta) + elseif (n_Lambert.EQ.1.) then + cos_theta = sqrt(1.-randomVar) + sin_theta = sqrt(randomVar) + else + cos_theta = (1.-randomVar)**(1./(n_Lambert + 1)) + sin_theta = sqrt(1.-cos_theta*cos_theta) + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung(sigma,wert) +c ======================================= + + IMPLICIT NONE + + real sigma ! Breite der Gaussverteilung + real wert ! gewuerfelte Returnvariable + real radius,phi + + integer seed + common /seed/ seed + + real zwoPi + parameter (zwoPi = 2.*3.1415927) + +c Da die eindimensionale Gaussfunktion nicht integrierbar ist, wird erst +c ein Punkt in der Ebene mit der entsprechenden zweidimensionalen Gaussfunktion +c gewuerfelt. Von diesem Punkt wird dann die x-Komponente zurueckgegeben, die +c eindimensional Gaussverteilt ist: + + radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = zwoPi * ran(seed) + wert = radius * cos(phi) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung_theta(sigma,theta) +c ============================================== + + IMPLICIT NONE + + real sigma,theta + real radius,phi,ratio + + integer i, seed + common /seed/ seed + +c Man beachte, dass hier Winkel gewuerfelt werden! D.h., dass die Variable +c 'radius' einen Radius in einer 2dimensionalen 'Winkel'-Ebene darstellt. +c Es wird angenommen, dass sigma in degree angegeben wird (daher die sind()- +c Funktion in der Zuweisung fuer 'ratio' anstelle der sin()-Fkt.). + + i = 1 + +1 radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = 360.*ran(seed) + theta = abs(radius * cosd(phi)) + ! nur theta zwischen 0 und 90 deg sollen eine Chance haben: + if (theta.GT.90) then + i = i + 1 + if (i.LE.10000) then + goto 1 + else + write(*,*) + write(*,*) 'SUBROUTINE Gauss_Verteilung_theta:' + write(*,*) ' Nach 10000 Versuchen noch keinen Winkel < 90 degree gewuerfelt.' + write(*,*) ' Vorgegebenes Sigma der Winkelverteilung: ',sigma + write(*,*) + STOP + endif + endif + +c Zitat aus TP's 'TESTSEED.FOR', aus welchem diese Routine abgeschrieben +c ist: +c +c Now we habe a GAUSSIAN, but we need for multiple scattering +c GAUSSIAN*SIN(x) =: g(x). This is not integrateable analytically, but +c we can choose the VON NEUMANN REJECTION to get what we want. +c As auxiliary function we choose the GAUSSIAN =: f(x), because it +c satisfies g(x) <= f(x) for all x. +c We must build the ratio g(x)/f(x) = sin(x) and compare it to +c another random number: + + ratio = sind(theta) + if (ran(seed).GT.ratio) goto 1 ! Verteilung zurechtbiegen + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE G_Functions(G1,G2,tau) +c ================================= + +c Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau' +c Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von +c Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts- +c breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253 +c (1971)) + + IMPLICIT NONE + + real tau,g1,g2 + real tau_(26),g1_(26),g2_(26) + real help + + integer i + + DATA tau_ /0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, + + 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0, + + 10.0, 12.0, 14.0, 16.0, 18.0, 20.0 / + + DATA g1_ /0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575, + + 0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850, + + 1.990,2.270,2.540,2.800,3.050,3.290 / + DATA g2_ / 0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59, + + 0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32, + + 0.30,0.26,0.22,0.18,0.15,0.13 / + + if (tau.LT.tau_(1)) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist kleiner als kleinster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(1) = ',tau_(1) + write(*,*) + STOP + endif + + i = 1 + +10 i = i + 1 + if (i.EQ.27) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist groesser als groesster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(26) = ',tau_(26) + write(*,*) + STOP + elseif (tau.gt.tau_(i)) then + goto 10 + endif + + +c lineare Interpolation zwischen Tabellenwerten: + + help = (tau-tau_(i-1))/(tau_(i)-tau_(i-1)) + + g1 = g1_(i-1) + help*(g1_(i)-g1_(i-1)) + g2 = g2_(i-1) + help*(g2_(i)-g2_(i-1)) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine Get_F_Function_Meyer(tau,Ekin) +c ========================================= + + implicit none + + real tau + real Ekin + + real thetaSchlange,thetaSchlangeMax + real theta,thetaMax,thetaStep + real f1,f2,F + + +c------------------------------------ +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target +c real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + + real Pi ! die Kreiszahl + +c parameter (a0 = 5.29E-9) + parameter (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10) + parameter (Pi = 3.141592654) + + real Meyer_Faktor3 + real Meyer_Faktor4 + real zzz ! 'Hilfsparameter' + real Meyer_Faktor5 + + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare) * Pi/180.) + parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare)) + parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi)) + +c------------------------------------ + + integer nBin,nBinMax + parameter (nBinMax=201) + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + integer i + real rhelp + + integer HB_memsize + parameter(HB_memsize=500000) + real memory(HB_memsize) + COMMON /PAWC/ memory + + +c nur noch fuer Testzwecke: + + real fValues(203) + real fValuesFolded(203) + + integer idh + parameter (idh = 50) + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + character filename*20 ! Name der Ausgabe-Dateien + COMMON /filename/ filename + +c------------------------------------------------------------------------------- + +c Festlegen des maximalen Theta-Wertes sowie der Schrittweite: + + if (tau.LT.0.2) then + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP' + call exit + elseif (tau.LE.2.) then + ! => Tabelle A + thetaSchlangeMax = 4.0 + elseif (tau.LE.8.) then + ! => Tabelle B + thetaSchlangeMax = 7.0 + elseif (tau.LE.20.) then + ! => Tabelle C + thetaSchlangeMax = 20.0 + else + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP' + call exit + endif + + thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin + if (thetaMax.GT.50) then + thetaStep = .5 + elseif (thetaMax.GT.25) then + thetaStep = .25 + elseif (thetaMax.GT.12.5) then + thetaStep = .125 + else + thetaStep = .0625 + endif + + +c Tabelle der F-Werte erstellen: + + nBin = 0 + do theta = thetaStep, thetaMax, thetaStep + + ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich + ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen): + + thetaSchlange = Meyer_faktor4 * Ekin * theta + + ! Auslesen der Tabellenwerte fuer die f-Funktionen: + + call F_Functions_Meyer(tau,thetaSchlange,f1,f2) + if (thetaSchlange.EQ.-1) then + ! wir sind jenseits von thetaSchlangeMax + goto 10 + endif + + ! Berechnen der Streuintensitaet: + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + + nBin = nBin + 1 + if (nBin.GT.nBinMax) then + write(*,*) 'nBin > nBinMax => EXIT' + call exit + endif + value(nBin) = sind(theta)*F + + fValues(nBin+1) = F ! fuer Testzwecke + fValuesFolded(nBin+1) = sind(theta)*F ! fuer Testzwecke + + enddo + + +c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + +10 do i = 1, nBin + area(i) = (value(i)+value(i-1))/2. * thetaStep + integ(i) = integ(i-1) + area(i) + enddo + + +c Normiere totale Flaeche auf 1: + + rHelp = integ(nBin) + do i = 1, nBin + value(i) = value(i) / rHelp + area(i) = area(i) / rHelp + integ(i) = integ(i) / rHelp + enddo + + +c vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + ! Berechne die Werte fuer theta=0: + + call F_Functions_Meyer(tau,0.,f1,f2) + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + fValues(1) = F + fValuesFolded(1) = 0. + + ! Gib die Werte in das Tabellenfile aus: + +c theta = 0. +c open (10,file=outDir//':'//filename//'.TAB',status='NEW') +c do i = 1, nBin+1 +c write(10,*) theta, fValues(i), fValuesFolded(i) +c theta = theta + thetaStep +c enddo +c close (10) + + + ! Buchen und Fuellen der Histogramme: + + call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh,fValues) + call HRPUT(idh,outDir//':'//filename//'.RZ','N') + call HDELET(idh) + + call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh+1,fValuesFolded) + call HRPUT(idh+1,outDir//':'//filename//'.RZ','U') + call HDELET(idh+1) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine throwMeyerAngle (theta) +c ================================== + + implicit none + + real lowerbound,y1,y2,f,root,radiant,fraction + integer bin,nBin + integer nBinMax + parameter (nBinMax=201) + + real theta,thetaStep + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + real rhelp + + real random + integer seed + common /seed/ seed + + +c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von +c random erreicht oder ueberschreitet: + + random = ran(seed) + + bin = 1 + do while (random.GT.integ(bin)) + bin = bin + 1 + if (bin.GT.nBin) then + write(*,*) 'error 1' + call exit + endif + enddo + + fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1)) + y1 = value(bin-1) + y2 = value(bin) + f = thetaStep / (y2-y1) + rHelp = y1*f + + radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f + root = SQRT(radiant) + lowerBound = real(bin-1)*thetaStep + if (f.GT.0) then + theta = lowerBound - rHelp + root + else + theta = lowerBound - rHelp - root + endif + + + END + + +c=============================================================================== + + options /extend_source + + subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2) +c ===================================================== + + implicit none + +c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau' +c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den +c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine +c verwendeten Tabellen sind eben dieser Referenz entnommen: +c L.Meyer, phys.stat.sol. (b) 44, 253 (1971) + + real tau,thetaSchlange + real f1, f2, f1_(2), f2_(2) + + integer column_,column,row + + integer iColumn + real weightCol, weightRow + +c------------------------------------------------------------------------------- + +c die Tabellendaten der Referenz (Tabellen 2 und 3): + + integer nColumn + parameter (nColumn = 25) + real tau_(nColumn) / + + 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, + + 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 10., 12., 14., 16., 18., 20. / + + integer nRowA + parameter (nRowA = 25) + real thetaSchlangeA(nRowA) / + + .00, .05, .10, .15, .20, .25, .30, .35, .40, .45, .50, .60, + + .70, .80, .90, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, 3.5, 4.0 / + + integer nRowB + parameter (nRowB = 24) + real thetaSchlangeB(nRowB) / + + 0.0, 0.2, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.5, 1.6, 1.8, + + 2.0, 2.2, 2.4, 2.6, 2.8, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0 / + + integer nRowC + parameter (nRowC = 24) + real thetaSchlangeC(nRowC) / + + 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, + + 7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., 16., 18., 20. / + + + real f1_A(9,nRowA) + + /1.69E+2,4.55E+1,2.11E+1,1.25E+1,8.48E+0,6.21E+0,4.80E+0,3.86E+0,3.20E+0, + + 9.82E+1,3.72E+1,1.97E+1,1.20E+1,8.27E+0,6.11E+0,4.74E+0,3.83E+0,3.17E+0, + + 3.96E+1,2.58E+1,1.65E+1,1.09E+1,7.73E+0,5.82E+0,4.58E+0,3.72E+0,3.10E+0, + + 1.76E+1,1.58E+1,1.27E+1,9.26E+0,6.93E+0,5.38E+0,4.31E+0,3.55E+0,2.99E+0, + + 8.62E+0,1.01E+1,9.45E+0,7.58E+0,6.02E+0,4.85E+0,3.98E+0,3.33E+0,2.84E+0, + + 4.65E+0,6.55E+0,6.91E+0,6.06E+0,5.11E+0,4.28E+0,3.62E+0,3.08E+0,2.66E+0, + + 2.74E+0,4.45E+0,5.03E+0,4.78E+0,4.27E+0,3.72E+0,3.23E+0,2.82E+0,2.47E+0, + + 1.77E+0,3.02E+0,3.71E+0,3.76E+0,3.53E+0,3.20E+0,2.86E+0,2.55E+0,2.27E+0, + + 1.22E+0,2.19E+0,2.78E+0,2.96E+0,2.91E+0,2.73E+0,2.51E+0,2.28E+0,2.07E+0, + + 8.82E-1,1.59E+0,2.12E+0,2.35E+0,2.39E+0,2.32E+0,2.19E+0,2.03E+0,1.87E+0, + + 6.55E-1,1.20E+0,1.64E+0,1.88E+0,1.97E+0,1.96E+0,1.90E+0,1.79E+0,1.68E+0, + + 3.80E-1,7.15E-1,1.01E+0,1.22E+0,1.35E+0,1.40E+0,1.41E+0,1.39E+0,1.34E+0, + + 2.26E-1,4.45E-1,6.44E-1,8.08E-1,9.28E-1,1.01E+0,1.05E+0,1.06E+0,1.05E+0, + + 1.39E-1,2.80E-1,4.21E-1,5.45E-1,6.46E-1,7.22E-1,7.75E-1,8.07E-1,8.21E-1, + + 8.22E-2,1.76E-1,2.78E-1,3.71E-1,4.53E-1,5.21E-1,5.74E-1,6.12E-1,6.37E-1, + + 5.04E-2,1.11E-1,1.86E-1,2.57E-1,3.22E-1,3.79E-1,4.27E-1,4.65E-1,4.94E-1, + + 2.51E-2,5.60E-2,9.24E-2,1.31E-1,1.69E-1,2.02E-1,2.40E-1,2.71E-1,2.97E-1, + + 1.52E-2,3.20E-2,5.08E-2,7.23E-2,9.51E-2,1.18E-1,1.41E-1,1.63E-1,1.83E-1, + + 1.03E-2,2.05E-2,3.22E-2,4.55E-2,6.01E-2,7.53E-2,9.02E-2,1.05E-1,1.19E-1, + + 8.80E-3,1.48E-2,2.25E-2,3.13E-2,4.01E-2,5.03E-2,6.01E-2,7.01E-2,8.01E-2, + + 6.10E-3,1.15E-2,1.71E-2,2.28E-2,2.89E-2,3.52E-2,4.18E-2,4.86E-2,5.55E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,1.71E-2,1.98E-2,2.28E-2,2.58E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.90E-3,1.02E-2,1.16E-2,1.31E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,4.90E-3,5.70E-3,6.40E-3,7.20E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.90E-3,3.40E-3,3.90E-3,4.30E-3/ + + real f1_B(9,nRowB) + + /2.71E+0,1.92E+0,1.46E+0,1.16E+0,9.52E-1,8.03E-1,6.90E-1,5.32E-1,4.28E-1, + + 2.45E+0,1.79E+0,1.39E+0,1.12E+0,9.23E-1,7.82E-1,6.75E-1,5.23E-1,4.23E-1, + + 1.87E+0,1.48E+0,1.20E+0,9.96E-1,8.42E-1,7.24E-1,6.32E-1,4.98E-1,4.07E-1, + + 1.56E+0,1.30E+0,1.09E+0,9.19E-1,7.89E-1,6.86E-1,6.03E-1,4.80E-1,3.95E-1, + + 1.28E+0,1.11E+0,9.62E-1,8.33E-1,7.27E-1,6.40E-1,5.69E-1,4.59E-1,3.81E-1, + + 8.23E-1,7.90E-1,7.29E-1,6.64E-1,6.01E-1,5.44E-1,4.94E-1,4.12E-1,3.49E-1, + + 5.14E-1,5.36E-1,5.29E-1,5.07E-1,4.78E-1,4.47E-1,4.16E-1,3.60E-1,3.13E-1, + + 3.19E-1,3.58E-1,3.76E-1,3.78E-1,3.70E-1,3.57E-1,3.45E-1,3.08E-1,2.76E-1, + + 2.02E-1,2.40E-1,2.64E-1,2.77E-1,2.82E-1,2.80E-1,2.65E-1,2.59E-1,2.39E-1, + + 1.67E-1,1.96E-1,2.20E-1,2.36E-1,2.44E-1,2.47E-1,2.45E-1,2.35E-1,2.21E-1, + + 1.33E-1,1.61E-1,1.85E-1,2.02E-1,2.12E-1,2.18E-1,2.18E-1,2.14E-1,2.03E-1, + + 8.99E-2,1.12E-1,1.32E-1,1.48E-1,1.59E-1,1.67E-1,1.68E-1,1.75E-1,1.72E-1, + + 6.24E-2,7.94E-2,9.50E-2,1.09E-1,1.20E-1,1.29E-1,1.35E-1,1.42E-1,1.43E-1, + + 4.55E-2,5.74E-2,6.98E-2,8.11E-2,9.09E-2,9.92E-2,1.06E-1,1.15E-1,1.19E-1, + + 3.35E-2,4.22E-2,5.19E-2,6.11E-2,6.95E-2,7.69E-2,8.33E-2,9.28E-2,9.85E-2, + + 2.50E-2,3.16E-2,3.92E-2,4.66E-2,5.35E-2,6.00E-2,6.57E-2,7.49E-2,8.13E-2, + + 1.90E-2,2.40E-2,2.99E-2,3.58E-2,4.16E-2,4.70E-2,5.20E-2,6.05E-2,6.70E-2, + + 1.47E-2,1.86E-2,2.32E-2,2.79E-2,3.25E-2,3.70E-2,4.12E-2,4.89E-2,5.51E-2, + + 8.10E-3,1.04E-2,1.30E-2,1.57E-2,1.84E-2,2.12E-2,2.40E-2,2.93E-2,3.42E-2, + + 4.80E-3,6.20E-3,7.70E-3,9.30E-3,1.09E-2,1.26E-2,1.44E-2,1.79E-2,2.14E-2, + + 2.80E-3,3.80E-3,4.70E-3,5.70E-3,6.70E-3,7.50E-3,8.90E-3,1.13E-2,1.36E-2, + + 1.70E-3,2.30E-3,2.90E-3,3.60E-3,4.20E-3,4.90E-3,5.60E-3,7.20E-3,8.80E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.00E-3,2.80E-3,3.50E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.80E-4,1.20E-3,1.60E-3/ + + real f1_C(7,nRowC) + + /3.65E-1,2.62E-1,2.05E-1,1.67E-1,1.41E-1,1.21E-1,1.05E-1, + + 3.33E-1,2.50E-1,1.95E-1,1.61E-1,1.36E-1,1.18E-1,1.03E-1, + + 2.75E-1,2.18E-1,1.76E-1,1.48E-1,1.27E-1,1.11E-1,9.80E-2, + + 2.04E-1,1.75E-1,1.50E-1,1.29E-1,1.13E-1,1.01E-1,9.00E-2, + + 1.41E-1,1.31E-1,1.19E-1,1.08E-1,9.71E-2,8.88E-2,8.01E-2, + + 9.32E-2,9.42E-2,9.10E-2,8.75E-2,8.00E-2,7.44E-2,6.91E-2, + + 5.98E-2,6.52E-2,6.72E-2,6.62E-2,6.40E-2,6.12E-2,5.82E-2, + + 3.83E-2,4.45E-2,4.80E-2,4.96E-2,4.98E-2,4.90E-2,4.77E-2, + + 2.46E-2,3.01E-2,3.40E-2,3.65E-2,3.79E-2,3.84E-2,3.83E-2, + + 1.59E-2,2.03E-2,2.39E-2,2.66E-2,2.85E-2,2.97E-2,3.04E-2, + + 1.04E-2,1.37E-2,1.66E-2,1.92E-2,2.12E-2,2.27E-2,2.37E-2, + + 4.39E-3,6.26E-3,8.26E-3,9.96E-3,1.15E-2,1.29E-2,1.41E-2, + + 2.06E-3,3.02E-3,4.24E-3,5.28E-3,6.32E-3,7.32E-3,8.26E-3, + + 1.21E-3,1.69E-3,2.24E-3,2.85E-3,3.50E-3,4.16E-3,4.82E-3, + + 8.50E-4,1.10E-3,1.38E-3,1.65E-3,2.03E-3,2.45E-3,2.88E-3, + + 5.90E-4,7.40E-4,8.50E-4,9.90E-4,1.23E-3,1.49E-3,1.71E-3, + + 3.90E-4,4.60E-4,5.20E-4,6.30E-4,7.65E-4,9.65E-4,1.12E-3, + + 2.40E-4,2.70E-4,3.10E-4,3.98E-4,4.97E-4,6.03E-4,7.18E-4, + + 1.50E-4,1.70E-4,2.15E-4,2.70E-4,3.35E-4,4.35E-4,5.00E-4, + + 1.00E-4,1.20E-4,1.46E-4,1.90E-4,2.40E-4,2.88E-4,3.43E-4, + + 0.00 ,0.00 ,1.04E-4,1.41E-4,1.80E-4,2.10E-4,2.50E-4, + + 0.00 ,0.00 ,8.20E-5,1.06E-4,1.38E-4,1.58E-4,1.85E-4, + + 0.00 ,0.00 ,5.40E-5,7.00E-5,8.60E-5,1.03E-4,1.20E-4, + + 0.00 ,0.00 ,4.20E-5,5.40E-5,6.50E-5,7.70E-5,8.80E-5/ + + real f2_A(9,nRowA) + + / 3.52E+3, 3.27E+2, 9.08E+1, 3.85E+1, 2.00E+1, 1.18E+1, 7.55E+0, 5.16E+0, 3.71E+0, + + 2.58E+2, 1.63E+2, 7.30E+1, 3.42E+1, 1.85E+1, 1.11E+1, 7.18E+0, 4.96E+0, 3.59E+0, + + -1.12E+2, 4.84E+0, 3.56E+1, 2.34E+1, 1.45E+1, 9.33E+0, 6.37E+0, 4.51E+0, 3.32E+0, + + -5.60E+1,-1.12E+1, 9.87E+0, 1.24E+1, 9.59E+0, 7.01E+0, 5.16E+0, 3.83E+0, 2.91E+0, + + -2.13E+1,-1.22E+1,-2.23E+0, 3.88E+0, 5.15E+0, 4.65E+0, 3.87E+0, 3.12E+0, 2.45E+0, + + -8.25E+0,-9.58E+0,-5.59E+0,-1.40E+0, 1.76E+0, 2.71E+0, 2.71E+0, 2.35E+0, 1.95E+0, + + -3.22E+0,-6.12E+0,-5.28E+0,-2.87E+0,-1.92E-1, 1.32E+0, 1.69E+0, 1.74E+0, 1.48E+0, + + -1.11E+0,-3.40E+0,-4.12E+0,-3.08E+0,-6.30E-1, 3.60E-1, 9.20E-1, 1.03E+0, 1.04E+0, + + -2.27E-1,-2.00E+0,-2.93E+0,-2.69E+0,-1.48E+0,-3.14E-1, 2.69E-1, 5.28E-1, 6.09E-1, + + 1.54E-1,-1.09E+0,-2.10E+0,-2.15E+0,-1.47E+0,-6.77E-1,-1.80E-1, 1.08E-1, 2.70E-1, + + 3.28E-1,-6.30E-1,-1.50E+0,-1.68E+0,-1.34E+0,-8.43E-1,-4.60E-1,-1.85E-1,-4.67E-3, + + 3.32E-1,-2.06E-1,-7.32E-1,-9.90E-1,-9.42E-1,-8.20E-1,-6.06E-1,-4.51E-1,-3.01E-1, + + 2.72E-1,-3.34E-2,-3.49E-1,-5.65E-1,-6.03E-1,-5.79E-1,-5.05E-1,-4.31E-1,-3.45E-1, + + 2.02E-1, 2.80E-2,-1.54E-1,-3.00E-1,-3.59E-1,-3.76E-1,-4.60E-1,-3.40E-1,-3.08E-1, + + 1.38E-1, 4.84E-2,-5.56E-2,-1.44E-1,-2.04E-1,-2.39E-1,-2.54E-1,-2.49E-1,-2.48E-1, + + 9.47E-2, 4.86E-2,-1.08E-2,-6.44E-2,-1.02E-1,-1.34E-1,-1.62E-1,-1.79E-1,-1.87E-1, + + 5.33E-2, 3.71E-2, 1.85E-2, 1.63E-3,-1.69E-2,-3.69E-2,-5.66E-2,-7.78E-2,-9.33E-2, + + 3.38E-2, 2.40E-2, 1.62E-2, 9.90E-3, 3.76E-3,-4.93E-3,-1.66E-2,-3.05E-2,-4.22E-2, + + 2.12E-2, 1.56E-2, 1.05E-2, 7.80E-3, 7.92E-3, 6.30E-3, 3.20E-4,-8.50E-3,-1.66E-2, + + 1.40E-2, 9.20E-3, 5.30E-3, 4.70E-3, 6.31E-3, 8.40E-3, 5.30E-3, 8.80E-4,-3.30E-3, + + 9.20E-3, 4.70E-3, 1.70E-3, 2.60E-3, 4.49E-3, 6.60E-3, 6.00E-3, 4.70E-3, 2.80E-3, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + real f2_B(9,nRowB) + + / 2.75E+0, 1.94E+0, 9.13E-1, 6.06E-1, 4.26E-1, 3.14E-1, 2.40E-1, 1.51E-1, 1.03E-1, + + 1.94E+0, 1.16E+0, 7.56E-1, 5.26E-1, 3.81E-1, 2.87E-1, 2.23E-1, 1.43E-1, 9.78E-2, + + 5.85E-1, 5.04E-1, 4.10E-1, 3.30E-1, 2.69E-1, 2.17E-1, 1.78E-1, 1.22E-1, 8.71E-2, + + 7.83E-2, 2.00E-1, 2.35E-1, 2.19E-1, 1.97E-1, 1.73E-1, 1.48E-1, 1.08E-1, 7.93E-2, + + -1.82E-1, 1.56E-2, 1.04E-1, 1.36E-1, 1.38E-1, 1.31E-1, 1.19E-1, 9.46E-2, 7.19E-2, + + -2.71E-1,-1.66E-1,-7.29E-2,-4.74E-3, 3.60E-2, 5.50E-2, 6.28E-2, 5.98E-2, 5.09E-2, + + -1.87E-1,-1.58E-1,-1.09E-1,-5.80E-2,-2.03E-2, 2.48E-3, 1.99E-2, 3.36E-2, 3.27E-2, + + -1.01E-1,-1.05E-1,-8.95E-2,-6.63E-2,-3.93E-2,-2.38E-2,-9.22E-3, 8.47E-3, 1.52E-2, + + -5.19E-2,-6.47E-2,-6.51E-2,-5.62E-2,-4.51E-2,-3.49E-2,-2.45E-2,-8.19E-3, 2.05E-3, + + -3.68E-2,-4.89E-2,-5.36E-2,-5.06E-2,-4.27E-2,-3.65E-2,-2.80E-2,-1.33E-2,-3.47E-3, + + -2.33E-2,-3.69E-2,-4.41E-2,-4.38E-2,-3.97E-2,-3.50E-2,-2.88E-2,-1.60E-2,-6.68E-3, + + -8.76E-3,-2.07E-2,-2.90E-2,-3.17E-2,-3.09E-2,-2.92E-2,-2.63E-2,-1.79E-2,-1.03E-2, + + -1.20E-3,-1.11E-2,-1.90E-2,-2.20E-2,-2.32E-2,-2.24E-2,-2.10E-2,-1.66E-2,-1.11E-2, + + 1.72E-3,-4.82E-3,-1.02E-2,-1.42E-2,-1.65E-2,-1.66E-2,-1.60E-2,-1.39E-2,-1.09E-2, + + 2.68E-3,-1.18E-3,-5.19E-3,-8.30E-5,-1.01E-2,-1.14E-2,-1.16E-2,-1.16E-2,-9.99E-3, + + 2.81E-3, 8.21E-4,-1.96E-3,-3.99E-3,-5.89E-3,-7.13E-3,-8.15E-3,-9.05E-3,-8.60E-3, + + 2.61E-3, 1.35E-3,-2.99E-4,-1.79E-3,-3.12E-3,-4.44E-3,-5.61E-3,-7.01E-3,-7.27E-3, + + 2.06E-3, 1.45E-3, 4.64E-4,-5.97E-4,-1.71E-3,-2.79E-3,-3.84E-3,-5.29E-3,-5.90E-3, + + 1.07E-3, 9.39E-4, 8.22E-4, 3.58E-4,-1.15E-4,-6.60E-4,-1.18E-3,-2.15E-3,-2.88E-3, + + 4.97E-4, 5.46E-4, 6.15E-4, 5.56E-4, 3.14E-4, 9.80E-5,-1.30E-4,-5.98E-4,-1.07E-4, + + 1.85E-4, 3.11E-4, 4.25E-4, 4.08E-4, 3.63E-4, 3.04E-4, 2.24E-4, 2.80E-5,-2.10E-4, + + 4.80E-5, 1.48E-4, 2.44E-4, 2.80E-4, 3.01E-4, 3.11E-4, 3.13E-4, 2.40E-4, 1.10E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 1.39E-4, 1.80E-4, 1.80E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 4.38E-5, 7.30E-5, 8.40E-5/ + + real f2_C(7,nRowC) + + / 7.36E-2, 4.21E-2, 2.69E-2, 1.83E-2, 1.34E-2, 1.01E-2, 7.88E-3, + + 5.79E-2, 3.61E-2, 2.34E-2, 1.64E-2, 1.21E-2, 9.26E-3, 7.28E-3, + + 2.94E-2, 2.17E-2, 1.60E-2, 1.23E-2, 9.49E-3, 7.45E-3, 5.95E-3, + + 2.30E-3, 7.07E-3, 7.76E-3, 7.02E-3, 6.13E-3, 5.17E-3, 4.34E-3, + + -7.50E-3,-2.00E-3, 9.93E-4, 2.36E-3, 2.82E-3, 2.86E-3, 2.72E-3, + + -8.27E-3,-5.37E-3,-2.58E-3,-7.96E-4, 3.75E-4, 9.71E-4, 1.28E-3, + + -5.79E-3,-5.12E-3,-3.86E-3,-2.46E-3,-1.20E-3,-3.74E-4, 1.74E-4, + + -3.26E-3,-3.43E-3,-3.26E-3,-2.68E-3,-1.84E-3,-1.12E-3,-4.54E-4, + + -1.46E-3,-1.49E-3,-2.20E-3,-2.18E-3,-1.85E-3,-1.40E-3,-8.15E-4, + + -4.29E-4,-9.44E-4,-1.29E-3,-1.50E-3,-1.51E-3,-1.36E-3,-9.57E-4, + + -3.30E-5,-3.66E-4,-6.78E-4,-9.38E-4,-1.09E-3,-1.09E-3,-9.56E-4, + + 1.50E-4, 3.10E-5,-1.38E-4,-3.06E-4,-4.67E-4,-5.48E-4,-6.08E-4, + + 1.00E-4, 8.50E-5, 2.30E-5,-6.60E-5,-1.58E-4,-2.40E-4,-3.05E-4, + + 5.40E-5, 6.50E-5, 4.90E-5, 1.20E-5,-3.60E-5,-8.90E-5,-1.31E-4, + + 2.90E-5, 4.30E-5, 4.40E-5, 2.90E-5, 5.10E-6,-2.20E-5,-4.80E-5, + + 1.40E-5, 2.40E-5, 2.80E-5, 2.60E-5, 1.90E-5, 7.50E-6,-1.10E-5, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + +c=============================================================================== + +c Bestimme, welche Reihen der Tabellen fuer Interpolation benoetigt werden: + + if (tau.LT.tau_(1)) then + write(*,*) 'tau is less than the lowest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'minimum = ',tau_(1) + call exit + elseif (tau.GT.tau_(nColumn)) then + write(*,*) 'tau is greater than the highest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'maximum = ',tau_(nColumn) + call exit + endif + + column_ = 2 + do while (tau.GT.tau_(column_)) + column_ = column_ + 1 + enddo + ! Das Gewicht der Reihe zu groesserem Tau: + weightCol = (tau-tau_(column_-1)) / (tau_(column_)-tau_(column_-1)) + + +c Besorge fuer gegebenes 'thetaSchlange' die interpolierten f1- und f2 -Werte +c der beiden relevanten Reihen: +c iColumn = 1 => Reihe mit hoeherem Index +c iColumn = 2 => Reihe mit kleinerem Index + + + iColumn = 1 + + +5 continue + + if (column_.LE.9) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8 + + column = column_ + + if (thetaSchlange.LT.thetaSchlangeA(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeA(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeA(nRowA)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeA(nRowA) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeA(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeA(row-1)) / + + (thetaSchlangeA(row)-thetaSchlangeA(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_A(column,row-1) + + + weightRow * f1_A(column,row) + f2_(iColumn) = (1.-weightRow) * f2_A(column,row-1) + + + weightRow * f2_A(column,row) + + + elseif (column_.LE.18) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 2. Tabelle: 2.0 <= tau <= 7.0 + + column = column_ - 9 + + if (thetaSchlange.LT.thetaSchlangeB(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeB(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeB(nRowB)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeB(nRowB) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeB(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeB(row-1)) / + + (thetaSchlangeB(row)-thetaSchlangeB(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_B(column,row-1) + + + weightRow * f1_B(column,row) + f2_(iColumn) = (1.-weightRow) * f2_B(column,row-1) + + + weightRow * f2_B(column,row) + + + else ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 3. Tabelle: 8.0 <= tau <= 20. + + column = column_ - 18 + + if (thetaSchlange.LT.thetaSchlangeC(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeC(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeC(nRowC)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeC(nRowC) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeC(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeC(row-1)) / + + (thetaSchlangeC(row)-thetaSchlangeC(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_C(column,row-1) + + + weightRow * f1_C(column,row) + f2_(iColumn) = (1.-weightRow) * f2_C(column,row-1) + + + weightRow * f2_C(column,row) + + + endif ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + + if (iColumn.EQ.1) then + column_ = column_ - 1 + iColumn = 2 + goto 5 + endif + + f1 = weightCol*f1_(1) + (1.-weightCol)*f1_(2) + f2 = weightCol*f2_(1) + (1.-weightCol)*f2_(2) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE reset_statistics +c =========================== + + IMPLICIT NONE + + integer Nr,n,k + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c der allgemeine Statistikspeicher: (*) : braucht nicht resettet zu werden +c --------------------------------- +c +c statMem(1,Nr): 1. Wert: x(1) (*) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ergebnis-Statistik-Speicher resetten: + + do Nr = 1, stat_Anzahl + statMem(2,Nr) = 0. ! Summe der Werte + statMem(3,Nr) = 0. ! Summe der Quadrate + statMem(4,Nr) = 1.e10 ! Minimalwert + statMem(5,Nr) = -1.e10 ! Maximalwert + statMem(8,Nr) = 0. ! Anzahl + enddo + +c die Scaler fuer den Returncode des TDs und die Pfostenhits sowie die +c StartZaehler resetten: + + do n = 1, 2 ! (1: Projektile, 2: FolienElektronen) + start_nr(n) = 0 + do k = 1, 18 + statTD(n,k) = 0. + enddo + do k = 1, 75 + pfostenHit(k,n) = 0. + enddo + enddo + + +c der Statistikspeicher fuer das Teilchen-Schicksal: + + do k = smallest_code_Nr, Gebiete_Anzahl*highest_code_Nr + statDestiny(k) = 0 + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE fill_statMem(wert,Nr) +c ================================ + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real wert + integer Nr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Wird die Varianz der Verteilung einer Groesse x gemaess der Formel +c +c Var(x) = SQRT( - **2 ) , < > -> Erwartungswert +c +c mit +c = 1/n * Summe_ueber_i( x(i) ) +c = 1/n * Summe_ueber_i( x(i)**2 ) +c +c berechnet, so tritt manchmal aufgrund der beschraenkten Genauigkeit der +c numerischen Speicher das Problem auf, dass bei grossen Werten x(i) und +c kleiner Streuung der Ausdruck unter der Wurzel negativ wird, was erstens +c unphysikalisch ist und zweitens zum Programmabbruch fuehrt. +c +c Dieses Problem liesse sich vermeiden, wenn man die Groessen x(i) relativ +c zu ihrem Erwartungswert angeben wuerde, der aber erst im nachhinein bekannt +c ist. +c +c Als Naeherungsloesung verwende ich daher fuer die Berechnung der Varianz die +c x(i) relativ zu x(1), also zum ersten Wert gemessen, der gerade bei kleiner +c Streuung, bei der das numerische Problem auftritt, nahe am Erwartungswert +c liegen sollte. +c +c statMem(1,Nr): 1. Wert: x(1) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c +c (*): wird im SUB 'eval_statistics' berechnet. +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Zaehle mit: + + statMem(8,Nr) = statMem(8,Nr) + 1. + + +c Speichere den ersten Wert: + + if (statMem(8,Nr).EQ.1) statMem(1,Nr) = wert + + +c Summiere die Abweichungen vom ersten Wert: + + statMem(2,Nr) = statMem(2,Nr) + (wert-statMem(1,Nr)) + + +c Summiere die Quadratischen Abweichungen vom ersten Wert: + + statMem(3,Nr) = statMem(3,Nr) + (wert-statMem(1,Nr))**2. + + +c Speichere den kleinsten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(4,Nr) = 1.e10): + + if (statMem(4,Nr).GT.wert) statMem(4,Nr) = wert + + +c Speichere den groessten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(5,Nr) = -1.e10): + + if (statMem(5,Nr).LT.wert) statMem(5,Nr) = wert + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE eval_statistics +c ========================== + + IMPLICIT NONE + +c statMem(1,Nr): 1. Wert: x(1) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert +c statMem(7,Nr): Varianz +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' +c ('StartsProSchleife' == n_par(0)) + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real n ! Anzahl der Werte, == statMem(8,Nr) + real radiant + + integer Nr,l + + + do Nr = 1, Stat_Anzahl + if (statNeeded(Nr)) then + n = statMem(8,Nr) + if (n.ne.0.) then + + !c Berechne Mittelwert: + statMem(6,Nr) = statMem(2,Nr)/n + statMem(1,Nr) + + !c Berechne Varianz: + radiant = ( statMem(3,Nr) - (statMem(2,Nr)**2. )/n)/n + statMem(7,Nr) = sqrt(radiant) + + !c Berechne Anteil an allen gestarteten in Prozent + statMem(9,Nr) = 100.*n/real(n_par(0)) + + else + + do l = 1, 9 + statMem(l,Nr) = 0. + enddo + + endif + endif + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SAVE_GRAPHICS_KOORD +c ============================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000) ! Koordinatenfelder fuer die + real yKoord(1000) ! Graphikausgabe + real zKoord(1000) ! +cMBc real tKoord(1000) ! + integer nKoord ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord ! fuer Graphikaufruf + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord ! fuer Graphikaufruf + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + nKoord = nKoord + 1 + + xKoord(nKoord) = x(1) + yKoord(nKoord) = x(2) + zKoord(nKoord) = x(3) +cMBc tKoord(nKoord) = t + + if (nKoord.EQ.1000) then + if (Gebiet.LE.upToChKoord) then ! Bahnberechnung wurde vor + call plot_horizontal ! Koordinatenwechsel abgebrochen + else + call plot_vertikal + endif + xKoord(1) = xKoord( 999) ! die letzten beiden uebernehmen, + yKoord(1) = yKoord( 999) ! damit gegebenenfalls der Richtungs- + zKoord(1) = zKoord( 999) ! pfeil gezeichnet werden kann. +cMBc tKoord(1) = tKoord( 999) + xKoord(2) = xKoord(1000) + yKoord(2) = yKoord(1000) + zKoord(2) = zKoord(1000) +cMBc tKoord(2) = tKoord(1000) + nKoord = 2 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Output_Debug +c ======================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + real Ekin, temp1, temp2 + + Ekin = (v(1)*v(1) + v(2)*v(2) + v(3)*v(3)) * Energie_Faktor + + if (Gebiet.EQ.1 .AND. alfaTgt.NE.0) then + if (alfaTgtVertically) then + temp1 = xGrid1*Cos_alfaTgt - x(3)*Sin_alfaTgt + temp2 = xGrid1*Sin_alfaTgt + x(3)*Cos_alfaTgt + write(lun(1),1) steps,Gebiet,t,temp1,x(2),temp2,v,Ekin + else + temp1 = xGrid1*Cos_alfaTgt - x(2)*Sin_alfaTgt + temp2 = xGrid1*Sin_alfaTgt + x(2)*Cos_alfaTgt + write(lun(1),1) steps,Gebiet,t,temp1,temp2,x(3),v,Ekin + endif + else + write(lun(1),1) steps,Gebiet,t,x,v,Ekin + endif + +1 format(X,I4,X,I2,4X,F6.1,2X,F7.2,X,F6.2,X,F6.2,2X,F6.2,X, + + F6.2,X,F6.2,2X,G13.6) + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Decay_Test(*) +c ======================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real dt + + if (t.GT.lifeTime) then ! Teilchen zerfallen + dt = t - lifeTime + t = lifeTime + x(1) = x(1) - dt*v(1) + x(2) = x(2) - dt*v(2) + x(3) = x(3) - dt*v(3) + destiny = code_decay + RETURN 1 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE chargeStateYields(E,masse,Yield_plus,Yield_zero) +c =========================================================== + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Die Funktion sowie die Parameter sind uebernommen aus: +c +c M.Gonin, R.Kallenbach, P.Bochsler: 'Charge exchange of hydrogen atoms +c in carbon foils at 0.4 - 120 keV', Rev.Sci.Instrum. 65 (3), March 1994 +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + IMPLICIT NONE + + real E ! kinetische Energie in keV + real masse ! in keV / c**2 + + real a_zero,a_minus + real k_Fermi,k_zero,k_minus + real zwo_k_Fermi + real k_Fermi_Quad,k_zero_Quad,k_minus_Quad + real vc_minus,vc_plus,v_Bohr,v_rel + + parameter ( a_zero = 0.953, a_minus = 0.029 ) + parameter ( k_Fermi = 1.178 ) ! [v_Bohr] + parameter ( k_Fermi_Quad = k_Fermi * k_Fermi ) + parameter ( zwo_k_fermi = 2. * k_Fermi ) + parameter ( k_zero = 0.991*k_Fermi ) ! [v_Bohr] + parameter ( k_zero_Quad = k_zero * k_zero ) + parameter ( k_minus = 0.989*k_Fermi ) ! [v_Bohr] + parameter ( k_minus_Quad = k_minus * k_minus ) + parameter ( vc_minus = 0.284, vc_plus = 0.193 ) ! [v_Bohr] + parameter ( v_Bohr = 7.2974E-3 ) ! [c] + + real Q_zero,Q_minus,D + real Yield_minus,Yield_zero,Yield_plus + + real help1,help2,help3 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (E.LT.0) then + write(*,*) + write(*,*) 'error in subroutine ''chargeStateYields'':' + write(*,*) 'E = ',E,' < 0!' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c Energie in Geschwindigkeit umrechnen (in Einheiten von v_Bohr): + +c - klassisch: + + v_rel = SQRT(2.*E/masse) / v_Bohr + +c - relativistisch: + +c help1 = 1. + E/masse +c v_rel = SQRT(1. - 1./(help1*help1)) / v_Bohr + + +c Die geladenen Anteile berechnen (vgl. obige Referenz): + + help1 = v_rel*v_rel + help2 = zwo_k_Fermi*v_rel + Q_zero = 1. + (k_zero_Quad - k_Fermi_Quad - help1) / help2 + Q_minus = 1. + (k_minus_Quad - k_Fermi_Quad - help1) / help2 + + + help1 = a_zero * Q_zero + help2 = a_minus * Q_minus + help3 = (1.-Q_zero)*(1.-Q_minus) + D = help1*(help2 + (1.-Q_minus)) + help3 + + Yield_minus = help1*help2 / D + Yield_plus = help3 / D + + Yield_minus = Yield_minus * exp(-vc_minus/v_rel) + Yield_plus = Yield_plus * exp(-vc_plus /v_rel) + + Yield_zero = 1. - (Yield_minus + Yield_plus) + +c write(6,*) 'E vrel Neutral Plus Minus' +c write(6,*) E, v_rel, yield_zero, yield_plus, yield_minus + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE test_wireHit(distToWire,WireRadiusQuad,v_x,v_y,WireHit) +c ================================================================== + +c Diese Routine ueberprueft, ob bei gegebenem Abstandsvektor 'distToWire' +c zwischen Teilchen und Draht und gegebener Geschwindigkeit v eines Teilchens +c bei geradliniger Bewegung und Drahtradius 'WireRadius' ein Schnittpunkt +c von Teilchenbahn und Drahtumfang existiert, ob also der Draht getroffen wird. +c Dafuer genuegt es zu pruefen, ob der Radiant der 'Mitternachtsformel' fuer die +c entsprechende quadratische Gleichung groesser oder gleich Null ist: + + IMPLICIT NONE + + real DistToWire(2),WireRadiusQuad,v_x,v_y + logical WireHit + + real steigung, help, radiant + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (abs(v_x).GT.abs(v_y)) then + steigung = v_y/v_x + help = distToWire(2) - distToWire(1) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + else + steigung = v_x/v_y + help = distToWire(1) - distToWire(2) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + endif + + if (radiant.ge.0) then + wireHit = .true. + else + wireHit = .false. + endif + + + END + + +c=============================================================================== diff --git a/mutrack/src/MUTRACK_VERSION_2-0-0.INPUT b/mutrack/src/MUTRACK_VERSION_2-0-0.INPUT new file mode 100644 index 0000000..ec3062f --- /dev/null +++ b/mutrack/src/MUTRACK_VERSION_2-0-0.INPUT @@ -0,0 +1,532 @@ +c=============================================================================== +c ERLAEUTERUNGEN : siehe Datei-Ende +c=============================================================================== +c KOMMENTARZEILEN: (Zeilen beginnend mit '@') +c=============================================================================== + + $parameter_liste + + TestRun = T ! -> fileNummern zwischen 9900 und 9999 [false] + + !============================================================================== + ! WEITERFUEHRUNG FRUEHERER SIMULATIONEN + !============================================================================== + + fileName_ACCEL = 'ac_9915' ! ACCEL-file + fileName_MUTRACK = 'mu_9915' ! prev. MUTRACK sim. up to TD-Foil + + previousSimulation = 1 ! fruehere Simulation fortfuehren? [ 0 ] + ! 0 : fromScratch + ! 1 : ACCEL + ! 2 : MUTRACK ('FoilFile') + + ! im Fall von 'priviousSimulation' = 1 oder = 2 (ACCEL oder MUTRACK): + + previousSettings = T ! uebernehme fruehere Schleifensettings [false] + ow_U_Tgt = f ! - aber ueberschreibe 'U_Tgt_' [false] + ow_U_Gua = f ! - aber ueberschreibe 'U_Gua_' [false] + ow_U_G1 = f ! - aber ueberschreibe 'U_G1_' [false] + ow_U_L1 = f ! - aber ueberschreibe 'U_L1_' [false] + ow_U_Sp = f ! - aber ueberschreibe 'U_Sp_' [false] + ow_U_L2 = f ! - aber ueberschreibe 'U_L2_' [false] + ow_U_Folie = f ! - aber ueberschreibe 'U_Folie_' [false] + !ow_B_TD = NICHT IMPLEMENTIERT ueberschreibe 'BTD_' [false] + !ow_B_Helm = NICHT IMPLEMENTIERT ueberschreibe 'BHelm_' [false] + ow_masse = f ! - aber ueberschreibe 'masse_' [false] + ow_ladung = f ! - aber ueberschreibe 'ladung_' [false] + ow_E0 = T ! - aber ueberschreibe 'E0_' [false] + ow_y0 = f ! - aber ueberschreibe 'y0_' [false] + ow_z0 = f ! - aber ueberschreibe 'z0_' [false] + ow_theta0 = f ! - aber ueberschreibe 'theta0_' [false] + ow_phi0 = f ! - aber ueberschreibe 'phi0_' [false] + ow_alfaTgt = f ! - aber ueberschreibe 'alfaTgt_' [false] + ow_alfaSp = f ! - aber ueberschreibe 'alfaSp_' [false] + ow_alfaTD = f ! - aber ueberschreibe 'alfaTD_' [false] + ow_deltaL1 = f ! - aber ueberschreibe 'deltaL1_' [false] + ow_artList = f ! - aber ueberschreibe 'artlist' [false] + + + !============================================================================== + ! KAMMER-SETTINGS UND TEILCHEN-PARAMETER + !============================================================================== + ! Einheiten: Spannungen in kV, Winkel in degree, Masse in keV/c**2, + ! Ladung in pos.Elementarlad., Energie in keV, Laengen in mm, + ! Zeiten in ns, Geschwindigkeiten in mm/ns + !------------------------------------------------------------------------------ + + ! - - - - - - - - - - Schleifen-Parameter - - - - - - - - - - - - - - - - - - - + + U_Tgt_ = 18 ! U(Target) [ 0. ] + U_Gua_ = 15 ! U(Guard) [ 0. ] + U_G1_ = 12 ! U(Gitter) [ 0. ] + U_L1_ = 5 ! U(kalte Linse) [ 0. ] + U_Sp_ = 13.5 ! U(Spiegel) [ 0. ] + U_L2_ = 4.5 ! U(warme Linse) [ 0. ] + U_L3_ = 4.5 ! U(warme Linse) [ 0. ] + + U_Folie_ = -2.980 ! U(Folie) [ 0. ] + U_Vorne_ = -2.790 ! U(Vorne) [ 0. ] + U_Hinten_ = -3.230 ! U(Hinten) [ 0. ] + U_MCP3_ = -2.600 ! U(MCP3) [ 0. ] + + U_MCP2_ = -1.87 ! U(MCP2) [ 0. ] + + !B_TD_ = NICHT IMPLEMENTIERT ! BFeld(Kompensationsspule) [ 0. ] + !B_Helm_ = NICHT IMPLEMENTIERT ! BFeld(Helmholtzpule) [ 0. ] + + alfaTgtVertically = f ! alfa(Target) = vertikale Verkippung + alfaTgt_ = 0 ! alfa(Target) (x=0,y=90) [ 0. ] + alfaSp_ = 45 ! alfa(Spiegel) (x=0,y=90) [45. ] + alfaTD_ = 0 ! alfa(Trigger) (x=0,y=90) [ 0. ] + + Masse_ = 0 ! (*) Masse [105659] + Ladung_ = 0 ! (*) Ladung [ 1. ] + + E0_ = 0.01 ! (*) Startenergie (in keV!) [ 0. ] + y0_ = 0 ! (*) y0 (Startposition) [ 0. ] + z0_ = 0 ! (*) z0 (Startposition) [ 0. ] + theta0_ = 0 ! (*) theta0 (Startwinkel)(x=0) [ 0. ] + phi0_ = 0 ! (*) phi0 (Startwinkel)(y=0,z=90)[ 0. ] + + Thickness_ = 3 ! Foliendicke in ug/cm**2 [ 3.0] + mean_Eloss_= 15 ! mittlerer Energieverlust in keV [ 0.0] + + DeltaL1_ = 0! -3,3,3 ! Verlaengerung 1 in mm [ 0.0] + DeltaL2_ = 0! -5,+5,1 ! Verlaengerung 2 in mm [ 0.0] + + ! (*) <-> siehe Dateiende + + ! - - - - - - - - - - Zufallsverteilte Startparameter - - - - - - - - - - - - - + + randomStarts = 5000 ! Anzahl zufallsverteilter Starts [ 50 ] + + ! Start-Energie: + random_energy = 1 ! 0: gemaess 'E0_' [ 0 ] + ! 1: E0_ + gleichverteilter Offset + ! 2: E0_ + gaussverteilter Offset + lowerE0 = .000 ! min. Energie (in keV!) [0.000] + upperE0 = .001 ! max. Energie (in keV!) [0.010] + sigmaE0 = .005 ! Breite der Gaussverteilung [0.010] + + ! Start-Position: + random_position = 0 ! 0: gemaess 'y0_' und 'z0_' [ 0 ] + ! 1: gleichverteilt auf Viereckflaeche + ! 2: gleichverteilt auf Kreisflaeche + ! 3: Gaussverteilt auf Viereckflaeche + ! 4: Gaussverteilt auf Kreisflaeche + StartBreite = -1 ! [TargetBreite] + StartHoehe = -1 ! [TargetHoehe ] + StartRadius = -1 ! [ 40 ] + sigmaPosition = 15 ! Breite der Gaussverteilung [ 15 ] + + + ! Start-Winkel: + random_winkel = 0 ! 0: gemaess 'theta0_' und 'phi0_' [ 0 ] + ! 1: Lambertverteilt + ! 2: Gaussverteilt + StartLambertOrd = 1 ! Ordnung der Lambert-Verteilung [ 1. ] + sigmaWinkel = 5 ! Breite der Gaussverteilung [ 1. ] + + ! - - - - - - - - - - Projektile (case-sensitive) - - - - - - - - - - - - - - - + + ! maximal 9 verschiedene aus: + + ! e+, e-, m+, m-, Mu, Mu-, H+, H, H-, H2+, H2, H2-, alfa ![ ' ' ] + ! H2O1, H2O2, H2O3, H2O4, H2O5, + ! Hyd1, Hyd2, Hyd3, Hyd4, Hyd5, Hyd6, Hyd7, Hyd8, Hyd9, + ! A11+, A12+, A21+, A31+, A32+, N11+, N21+, K11+, K12+ + + ! H2O1,H2O2,..,H2Oi,..: Wassercluster (H2O)i + ! Hyd1,Hyd2,..,Hydi,..: protonierte Wassercluster [(H2O)i]H+ + ! A: Argon, N: Stickstoff, K: Krypton + + ! (alle Zeichen in artList nach einem '!' werden ignoriert) + + artList = 'm+' + + ! nur verwendet falls 'log_neutralize = t': neutrale Anteile in % + ! (eine Angabe je Projektil, '-1' -> verwende Funktion von M. Gonin + ! fuer Neutralisierung von Protonen in Graphit). + + neutral_fract = 0 + + + ! - - - - - - - - - - Trigger-Detektor- - - - - - - - - - - - - - - - - - - - - + + TriggerInBeam = t ! TriggerDetektor im Strahlweg? [false] + transTDFoil = 88. ! Transmission der Folie in % [100.] + + log_neutralize = F ! Neutralisierung in der Folie? [false] + + n_E_Verlust = 5 ! 0: kein Energieverlust [ 0 ] + !<0: mittl. Verlust gemaess 'mean_Eloss_' + !>0: mittl. Verlust gemaess ICRU-Tabelle + !|1| keine Energieaufstreuung + !|2| Streuung gaussvert. gemaess 'sigmaE' + !|3| Streuung gleichvert. [lowerE,upperE] + !|4| Streuung gaussv. nach Lindhard/Scharff + !|5| Streuung gaussv. nach Yang (recommended + calculate_each = F ! bei ICRU: fuer jedes Teilchen neu? [false] + graphitData = F ! bei ICRU: Elossdaten fuer Graphit? [false] + ! (Alternative: amorpher Kohlenstoff) + sigmaE = 0.5 ! GaussBreite des Energieverlustes [ .5] + lowerE = 0 ! untere Grenze fuer Energieverlust [ 0. ] + upperE = 0.050 ! obere Grenze fuer Energieverlust [ .1] + + n_Aufstreu = 3 ! 0: keine Winkelaufstreuung [ 0 ] + ! 1: gemaess 'sigmaAufstreu' + ! 2: gemaess Meyer (gaussverteilte Winkel) + ! 3: gemaess Meyer (nach f-Funktion) + sigmaAufstreu = 2. ! Gaussbreite der Aufweitung [ 5. ] + + generate_FE = F ! FolienElektronen generieren? [false] + + + !============================================================================== + ! AUSGABE - STEUERUNG + !============================================================================== + + writeTraj2File = f ! Um das rausschreiben der Trajektorie in ein separates + ! file 'OUT.TRAJ' zu ermoeglichen, muessen im SourceCode + ! alle mit 'cMBc' herauskommentierten Zeilen aktiviert + ! werden. (Dieses feature wurden fuer M.B. implementiert + ! aber wegen Rechenzeitargumenten herauskommentiert) + + ! - - - - - - - - PHYSICA-Tabelle erstellen?- - - - - - - - - - - - - - - - - - + + createPhysTab = f ! [false] + + ! welche Statistiken? + + PHY_S1xM2 = t ! S1xM2 im PHYSICA-file? [false] + PHY_S1M2 = t ! S1M2 im PHYSICA-file? [false] + PHY_S1Fo = t ! S1Fo im PHYSICA-file? [false] + PHY_FoM2 = t ! FoM2 im PHYSICA-file? [false] + PHY_S1M3 = t ! S1M3 im PHYSICA-file? [false] + PHY_M3M2 = t ! M3M2 im PHYSICA-file? [false] + PHY_t_FE = t ! tFE im PHYSICA-file? [false] + PHY_y_Fo = t ! y(Folie) im PHYSICA-file? [false] + PHY_z_Fo = t ! z(Folie) im PHYSICA-file? [false] + PHY_r_Fo = t ! r(Folie) im PHYSICA-file? [false] + PHY_y_M2 = t ! y(MCP2) im PHYSICA-file? [false] + PHY_z_M2 = t ! z(MCP2) im PHYSICA-file? [false] + PHY_r_M2 = t ! r(MCP2) im PHYSICA-file? [false] + PHY_y_xM2 = t ! y(xMCP2) im PHYSICA-file? [false] + PHY_z_xM2 = t ! z(xMCP2) im PHYSICA-file? [false] + PHY_r_xM2 = t ! r(xMCP2) im PHYSICA-file? [false] + + ! welche statistischen Groessen? + + PHY_mean = t ! Mittelwerte? [false] + PHY_variance = t ! Varianzen? [false] + PHY_minimum = t ! Minimalwerte? [false] + PHY_maximum = t ! Maximalwerte? [false] + PHY_percent = t ! rel. Anteil beitragender Teilchen? [false] + + ! - - - - - - - - NTupel-relevante Vorgaben - - - - - - - - - - - - - - - - - - + + createNTP = t ! NTP-File erzeugen [false] + + Fo_triggered = F ! TD-Folientreffer verlangt [false] + xM2_triggered = F ! Erreichte MCP2-Ebene verlangt [false] + M2_triggered = F ! MCP2-Treffer verlangt [false] + + smearS1Fo = f ! Verschmierung von S1Fo in NTP (zur + sigmaS1fo = 1.6 ! Beruecksichtigung der Zeitaufloesung) + + NTP_S1xM2 = F ! - Flugzeit bis MCP2-Ebene? [false] + NTP_times = F ! - sonstige Flugzeiten? [false] + NTP_FoM2Only = F ! - von 'times' nur FoM2 (rezessiv!) [false] + NTP_lifetime = F ! - Lebenszeiten? [false] + NTP_start = F ! - Startgroessen? [false] + NTP_stop = F ! - Stopgroessen? [false] + NTP_40mm = F ! - Groessen bei x=40mm? [false] + NTP_Folie = t ! - Everlust und Aufstreuung? [false] + NTP_charge = F ! - Ladungszustand nach Folie? [false] + NTP_steps = F ! - min. und max. Schrittweiten? [false] + + ! - - - - - - - - - - Vorgaben fuer das Summary - - - - - - - - - - - - - - - - + + n_outWhere = 2 ! 0-> keine Ausgabe des Summarys [ 2 ] + ! 1-> Ausgabe nur in Datei + ! 2-> in Datei und auf Schirm + ! 3-> nur auf Schirm + !-1-> nur kleines Logfile + + SUM_S1xM2 = t ! S1xM2 im Summary? [false] + SUM_S1M2 = t ! S1M2 im Summary? [false] + SUM_S1Fo = t ! S1Fo im Summary? [false] + SUM_FoM2 = t ! FoM2 im Summary? [false] + SUM_S1M3 = t ! S1M3 im Summary? [false] + SUM_M3M2 = t ! M3M2 im Summary? [false] + SUM_t_FE = t ! tFE im Summary? [false] + SUM_y_Fo = t ! y(Folie) im Summary? [false] + SUM_z_Fo = t ! z(Folie) im Summary? [false] + SUM_r_Fo = t ! r(Folie) im Summary? [false] + SUM_y_M2 = t ! y(MCP2) im Summary? [false] + SUM_z_M2 = t ! z(MCP2) im Summary? [false] + SUM_r_M2 = t ! r(MCP2) im Summary? [false}SUM_FoM2SUM_FoM2 + SUM_y_xM2 = t ! y(xMCP2) im Summary? [false] + SUM_z_xM2 = t ! z(xMCP2) im Summary? [false] + SUM_r_xM2 = t ! r(MxCP2) im Summary? [false}SUM_FoM2SUM_FoM2 + + log_out_FE = F ! die FE-Statistik im Summary? [false] + log_out_pfosten(1)= F ! P : Pfosten einzeln im Summary? [false] + log_out_pfosten(2)= F ! FE: Pfosten einzeln im Summary? [false] + + ! - - - - - - - - File mit zugrundeliegender Geometrie erstellen? - - - - - - - + + write_geo = T ! [false] + + ! - - - - - - - - zu erstellende Tabellenfiles- - - - - - - - - - - - - - - - - + + Tab_S1xM2 = F ! Tabelle S1xM2 [false] + Tab_S1M2 = F ! Tabelle S1M2 [false] + Tab_S1Fo = F ! Tabelle S1Fo [false] + Tab_FoM2 = F ! Tabelle FoM2 [false] + Tab_S1M3 = F ! Tabelle S1M3 [false] + Tab_M3M2 = F ! Tabelle M3M2 [false] + Tab_t_FE = F ! Tabelle tFE [false] + Tab_y_Fo = F ! Tabelle y(Folie) [false] + Tab_z_Fo = F ! Tabelle z(Folie) [false] + Tab_r_Fo = F ! Tabelle r(Folie) [false] + Tab_y_M2 = F ! Tabelle y(MCP2) [false] + Tab_z_M2 = F ! Tabelle z(MCP2) [false] + Tab_r_M2 = F ! Tabelle r(MCP2) [false] + Tab_y_xM2 = F ! Tabelle y(xMCP2) [false] + Tab_z_xM2 = F ! Tabelle z(xMCP2) [false] + Tab_r_xM2 = F ! Tabelle r(xMCP2) [false] + + ! - - - - - - - - - - Graphikausgabe- - - - - - - - - - - - - - - - - - - - - - + + GRAPHICS = F ! Graphikausgabe der Trajektorien? [false] + GRAPHICS_Anzahl = 40 ! fuer wieviele Starts je Schleife? [ 25 ] + vertical = T ! Blick auf die Kammer VON OBEN? [true!] + log_marker = F ! Marker am Trajektorienende? [false] + plot_FE = F ! FE-Trajektorien plotten? [false] + + n_postSkript = 0 ! Postskript-files erstellen? [ 1 ] + ! 0 : nicht erstellen + ! 1 : Abfrage nach jeder Schleife + ! 2 : immer erstellen + + iMonitor = 3 ! Abtastfrequenz fuer Graphik [ 2 ] + color = 1 ! 0=schwarzweiss, 1=farbig [ 0 ] + schnitt_p = 2 ! Kammerteil: 1=horiz., 2=vertikal [ 2 ] + schnitt_x = -1 ! x-Koord. der Schnittebene [MCP2] + + !============================================================================== + ! GRUNDEINSSTELLUNGEN + !============================================================================== + + ! - - - - - - - - - - Programmsteuerung - - - - - - - - - - - - - - - - - - - - + + TestOnWireHit = t ! Drahttreffer beruecksichtigen? [false] + UseDecay = t ! MYONEN-Zerfall beruecksichtigen? [false] + + upToTDFoilOnly = F ! Integration nur bis zur TD-Folie [false] + + createFoilFile = F ! neues 'FoilFile' erstellen? [false] + + idealMirror = F ! Spiegel als ideal betrachten? [false] + + DEBUG = F ! Debug-Version? [false] + DEBUG_FE = F ! FE in Debug-Info? [false] + DEBUG_Anzahl = 3 ! fuer wieviele Starts je Schleife? [ 2 ] + + ! - - - - - - - - - - Geometrie - - - - - - - - - - - - - - - - - - - - - - - - + + Geo_fileName = 'GEO_KAMMER_RUN9_NEW_MUONS' + ! Geo_fileName = 'GEO_KAMMER_RUN9_NEW_PROTONS' + + ! Geo_fileName = '9nM' ! RunNummer bzw. Name des Geo-files + ! Geo_fileName = '9' ! RunNummer bzw. Name des Geo-files + ! '9n': mit laengerer Mappe fuer MCP2 + + gridInFrontOfFoil = f ! Gitter vor der Triggerfolie? [false] + ! ('grindInFrontOfFoil' nur bei Run 9) + xBlende = -1 ! Abstand der Blende zum MCP2 (-1 => none) + radius_Blende = 0 ! Radius der Blende vor MCP2 + + ! - - - - - - - - - - Startflaeche- - - - - - - - - - - - - - - - - - - - - - - + + StartFlaeche = 0 !-1: entsprechend x0_ und Kammerteil [ 0 ] + ! 0: Target + ! 1: 1. Gitter + ! 2: Folie (Startwinkel im Kammersystem) + ! 3: Folie (Startwinkel im Triggersystem) + + x0_ = 0 ! Startort rel zu. Tgt bzw. Spiegel [ 0. ] + Kammerteil = 1 ! 1: horizontal, 2: vertikal [ 1 ] + + ! - - - - - - - - - - Fehlerkontrolle - - - - - - - - - - - - - - - - - - - - - + + eps_x = 1.e-6 ! max. Fehler im Ort [1.e-5] + eps_v = 1.e-6 ! max. Fehler in Geschw. [1.e-5] + log_relativ = F ! relative Fehlerbetrachtung? [false] + + maxStep = 7000 ! max. Anzahl Integrationsschritte [ 1000] + + dtsmall = 0.00001 ! kleinster Integrations-Zeitschritt [0.001] + + maxBelowDtSmall = 700 ! max. Anzahl von dtSmall Unterschr. [ 50 ] + + ! - - - - - - - - - - seed- - - - - - - - - - - - - - - - - - - - - - - - - - + + seed_ = 0 ! > 1E6, ungerade (if .LE. 0 => automatic) + + $END + +c******************************************************************************** +c* +c* In dieser Datei werden die Parameter fuer die Flugbahnberechnung von +c* Teilchen in der NEMU-Apparatur mittels des Fortranprogramms 'MUTRACK' +c* festgelegt. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Alle Zeilen vor der Zeile ' $parameter_liste', die nicht mit 'c ' beginnen +c* und keine Leerzeilen sind, werden als Kommentarzeilen fuer das Mutrack- +c* Programm betrachtet und im Kopf des Logfiles ausgegeben. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Bleibt die rechte Seite einer Zuweisung frei (variable = ), so wird der +c* am Zeilenende in eckigen Klammern angegebene Defaultwert verwendet. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Jeder Parameter des Abschnitts 'SCHLEIFEN-PARAMETER' kann einen, zwei +c* oder mehrere aequidistante Werte annehmen. Die Eingabe geschieht +c* entsprechend in einer der Formen +c* +c* _parameter = wert +c* _parameter = wert1 , wert2 +c* _parameter = wert_min , wert_max , wert_step. +c* +c* Die Zuweisungen in den mit (*) markierten Zeilen des gleichen Abschnitts +c* kommen nur zum Tragen, wenn sie nicht durch prioritaere Zuweisungen +c* ueberdeckt werden. Fuer die Massen- und die Ladungsschleife geschieht dies +c* durch Spezifizieren von 'artList' im Abschnitt 'PROJEKTILE' (vgl. unten), +c* fuer die Energie-, Positions- und Winkel-Schleifen durch die Wahl einer +c* Zufallsverteilung fuer die entsprechende Groesse im Abschnitt 'ZUFALLS- +c* VERTEILTE STARTPARAMETER' ('random_energy', 'random_position' bzw. +c* 'random_winkel' > 0). +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Wird die Variable 'artList' im Abschnitt 'PROJEKTILE' mit einer Komma- +c* getrennten Liste aus +c* +c* m+, m-, Mu, Mu-, e+, e-, H+, H, H-, H2+, H2, H2-, alfa, +c* A11+, A12+, A21+, A31+, A32+, N11+, N21+, K11+, K12+, X11+, X12+ +c* +c* belegt (als String: z.B. 'm+,H+' ), so werden die Parameter 'Ladung' und +c* 'Masse' der Reihe nach mit den zugehoerigen Werten belegt. +c* (m=Myon, Mu=Myonium, e=Elektron, H=Wasserstoff, alfa=alpha-Teilchen). +c* Die zweite der beiden Zeilen gibt Kuerzel fuer Ionen schwererer Atome an: +c* 'Znm+' steht fuer einen "Cluster" aus n Atomen der Art 'Z' im Ladungszustand +c* m+. +c* A: Argon, N: Stickstoff, K: Krypton, X: Xenon. +c* +c* Soll diese Moeglichkeit nicht genutzt werden, so ist 'artList' undefiniert +c* zu belassen. +c* +c* Das Einlesen der Teilchenliste geschieht CASE-SENSITIVE. Ein '!' an +c* beliebiger Stelle der Teilchenliste bewirkt, dass alle Zeichen nach +c* dem ! ignoriert werden. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Befindet sich der Trigger im Strahlweg, so kann mit n_E_Verlust die Art +c* der Beruecksichtigung des Energieverlustes in der Triggerfolie gewaehlt +c* werden: +c* +c* n_E_Verlust=0: kein Energieverlust +c* n_E_Verlust=1: mittlerer Energieverlust gemaess 'mean_E_Verlust', +c* Breite der Energieverlustverteilung gemaess 'sigmaE'. +c* n_E_Verlust=2: Funktioniert nur mit einfach positiv geladenen +c* Teilchen und wenn die Startflaeche entweder der Moderator +c* oder das 1. Gitter ist. Der Energieverlust wird hier +c* ueber Geschwindigkeitsskalierung aus Protonendaten +c* gewonnen (ICRU-Tabelle). Im so erhaltenen Energieverlust +c* ist auch die Wegstreckenverlaengerung in der Folie +c* bei nicht senkrechtem Einfall beruecksichtigt (Einfalls- +c* richtung!). Mit 'sigmaE' ungleich Null kann die Energie- +c* verlustverteilung zusaetlich verbreitert werden. +c* Bei gewuerfelten Startenergien fuer die Projektile +c* wird fuer die Berechnung des mittleren Energieverlustes +c* der Mittelwert von 'lowerE0' und 'upperE0' verwendet, es +c* sei denn, dass 'calculate_each'=.true. gesetzt wurde. +c* In diesem Fall wird der Energieverlust fuer jedes +c* Teilchen neu berechnet. Dies soll es ermoeglichen, +c* groessere Bereiche fuer die Startenergie vorzugeben und +c* trotzdem sinnvolle Energieverluste zu erhalten. +c* Allerdings kann dies die Rechenzeit u. U. stark erhoehen. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Wird das logical 'log_marker' im Abschnitt 'Graphikausgabe' gesetzt, so +c* wird gegebenenfalls bei der Graphikdarstellung der Projektiltrajektorien +c* das Trajektorienende mit einem Marker versehen, wobei der Markertyp vom +c* Teilchenschicksal abhengt. Dabei gibt es aber momentan (Stand: Feb.96) noch +c* Probleme, da vor allem fuer Teilchen, die auf der aktiven Flaeche des +c* MCP2 aufschlagen, falsche Markertypen gewaehlt werden. +c* Scheint ein spezielles Problem der CERN-library zu sein und wird bis auf +c* weiteres nicht wieter verfolgt. Dieses feature wurde speziell fuer DEBUG- +c* Taetigkeiten entwickelt und sollte ansonsten nicht von besonderer Bedeutung +c* sein. +c* Die Teilchenschicksale und die zugehoerigen Markertypen sind: +c* +c* auf Rand des MCP2 : gefuellter Kreis +c* im TD abgebrochen : Stern (3 gekreuzte Linien) +c* Spiegel durchquert : gefuellter Kreis +c* MCP2 getroffen : leere Raute +c* zerfallen : Schweizerkreuz +c* Element verfehlt : leerer Kreis +c* reflektiert : leeres Dreieck +c* aufgeschlagen : gefuellter Kreis +c* verloren (steps>maxsteps) : gefuellter fuenfstrahliger Stern +c* Zeitschritt kleiner dtSmall : leerer fuenfstrahliger Stern +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Der Name der Ausgabedateien lautet 'MU_nnnn', wobei 'nnnn' eine durch- +c* laufende Nummer ist. Die Ausgabedateien erhalten je nach Inhalt eine der +c* Extensionen +c* +c* .LOG -> Summary-file +c* .NTP -> PAW-Ntupel +c* ._??? -> Statistik-Tabellen +c* .PHYSICA -> Gestamttabelle fuer Graphische Darstellung mit PHYSICA +c* .PS -> Postskript-Files mit Graphik der Bahnkurven. Bei diesen +c* Dateien wird der Dateiname um die Nummer der jeweiligen +c* Schleife, zu der die Graphik gehoert, erweitert. (Insofern +c* mehr als eine Schleife durchlaufen wird). +c* .GEO -> file mit der verwendeten Kammergeometrie. +c* .FOIL -> file mit Trajektoriendaten am Ort der Triggerfolie. Kann +c* von spaeteren MUTRACK runs eingelesen werden. +c* .INFO -> Info-file zu .FOIL mit den verwendeten Parametersettings. +c* +c* Die Dateien werden im Directory 'mutrack$OUTdirectory' abgelegt. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* Das Achsensystem ist mit dem Ursprung in die Mitte des Moderators +c* gelegt. Die x-Achse verlaeuft in Strahlrichtung, die z-Achse nach oben, +c* die y-Achse so, dass ein rechtshaendiges System besteht. +c* Nach dem Spiegel wird das Koordinatendreibein so gedreht, dass die x-Achse +c* wiederum in Strahlrichtung weist. Der Ursprung wird dabei in das Zentrum +c* des Doppelkreuzes der Spiegelaufhaengung verschoben. +c* +c* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c* +c* ***************************************************************** +c* * Die Zeilen * +c* * $PARAMETER_LISTE * +c* * und * +c* * $END * +c* * MUESSEN IN SPALTE ZWEI BEGINNEN! * +c* ***************************************************************** +c* * 26.09.1995 >> anselm.hofer@psi.ch * +c******************************************************************************* diff --git a/mutrack/src/READ_MAP.INC b/mutrack/src/READ_MAP.INC new file mode 100644 index 0000000..dd3a616 --- /dev/null +++ b/mutrack/src/READ_MAP.INC @@ -0,0 +1,48 @@ + +c=============================================================================== +c READ_MAP.INC +c=============================================================================== + +c Dieser Includefile erledigt fuer die Subroutinen 'READ_MAP_xx' das Einlesen +c der Potentialmappe und falls notwendig die Fehlerausgabe. + + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + + integer i,j, ihelp, iostat + + +c Einlesen der Potentialmappe: + + open (lunRead,file=mappenName//'.MAPPE', + + defaultfile=mappenDir,status='old', + + form='unformatted',recl=imax+1,readonly) +c + form='unformatted',recl=imax,readonly) + do j = 0, jmax + ihelp = j*(imax+1) + read(lunREAD,iostat=iostat) (map(ihelp+i),i=0,imax) + if (iostat.NE.0) then + write(*,*) + write(*,999) i,j,iostat + write(*,*)' Potentialmappe: ',mappenName + write(*,*)' Directory : ',mappenDir + write(*,*) + STOP + endif + enddo + close(lunREAD) +999 format(7x'error reading grid point (i,j) = ('i4','i4')'/7x'iostat = 'i4) + + +c da die Elektrodenbereiche bei RELAX3D negativ kodiert sind, nimm die +c Absolutbetraege: + + ihelp = 0 + do j=0, jmax + do i=0, imax + map(ihelp) = abs(map(ihelp)) + ihelp = ihelp + 1 + enddo + enddo + diff --git a/mutrack/src/READ_MAP_SP.INC b/mutrack/src/READ_MAP_SP.INC new file mode 100644 index 0000000..68b51c9 --- /dev/null +++ b/mutrack/src/READ_MAP_SP.INC @@ -0,0 +1,48 @@ + +c=============================================================================== +c READ_MAP.INC +c=============================================================================== + +c Dieser Includefile erledigt fuer die Subroutinen 'READ_MAP_xx' das Einlesen +c der Potentialmappe und falls notwendig die Fehlerausgabe. + + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + + integer i,j, ihelp, iostat + + +c Einlesen der Potentialmappe: + + open (lunRead,file=mappenName//Nr//'.MAPPE', + + defaultfile=mappenDir,status='old', + + form='unformatted',recl=imax+1,readonly) +c + form='unformatted',recl=imax,readonly) + do j = 0, jmax + ihelp = j*(imax+1) + read(lunREAD,iostat=iostat) (map(ihelp+i),i=0,imax) + if (iostat.NE.0) then + write(*,*) + write(*,999) i,j,iostat + write(*,*)' Potentialmappe: ',mappenName + write(*,*)' Directory : ',mappenDir + write(*,*) + STOP + endif + enddo + close(lunREAD) +999 format(7x'error reading grid point (i,j) = ('i4','i4')'/7x'iostat = 'i4) + + +c da die Elektrodenbereiche bei RELAX3D negativ kodiert sind, nimm die +c Absolutbetraege: + + ihelp = 0 + do j=0, jmax + do i=0, imax + map(ihelp) = abs(map(ihelp)) + ihelp = ihelp + 1 + enddo + enddo + diff --git a/mutrack/src/SUB_ARTLIST.FOR b/mutrack/src/SUB_ARTLIST.FOR new file mode 100644 index 0000000..4a76ffc --- /dev/null +++ b/mutrack/src/SUB_ARTLIST.FOR @@ -0,0 +1,226 @@ +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c +c Die Routinen dieser Datei werden in das Programm 'MUTRACK' 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,j ! Zaehlvariablen + logical flag + + 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 'mutrack$sourcedirectory:COM_MUTRACK.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (artList.EQ.' ') RETURN + + +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 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) then + ! -> Teilchen schon in Liste + if (.NOT.log_neutralize .OR. upToTDFoilOnly) then + ! ueberspringen: + goto 2 + elseif (neutral_fract(nummer).EQ.neutral_fract(k1)) then + ! -> Teilchen hat auch gleichen neutralen Anteil + ! wie zuvor => ueberspringe Eintragungen in + ! 'artList' und 'neutral_fract': + do j = nummer,artenMax-1 + neutral_fract(j) = neutral_fract(j+1) + enddo + goto 2 + endif + endif + 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 jetzt 'log_neutralize' gesetzt ist, pruefe, ob bei wenigstens einem der +c Teilchen in 'artList' tatsaechlich Neutralisierung in der Folie verlangt ist. +c Ansonsten setze 'log_neutralize' auf .false.: + + flag = .false. + do k = 1, nummer-1 + if ((neutral_fract(k).LT.0. .AND. neutral_fract(k).NE.-1.) .OR. + + neutral_fract(k).GT.100.) then + neutral_fract(k) = 0. + endif + if (neutral_fract(k).GT.0. .OR. neutral_fract(k).EQ.-1.) flag = .true. + enddo + if (.not.flag) log_neutralize = .false. + + +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*4 + + 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) ' >>>>> A11+, A12+, A21+, A31+, A32+, N11+, N21+, '// + + 'K11+, K12+, X11+, X12+' + write (*,1) ' >>>>> (das Einlesen erfolgt CASE SENSITIVE!)' + write (*,*) + +1 format(T10,A) + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_ELOSS.FOR b/mutrack/src/SUB_ELOSS.FOR new file mode 100644 index 0000000..1832d04 --- /dev/null +++ b/mutrack/src/SUB_ELOSS.FOR @@ -0,0 +1,663 @@ +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE CALC_ELOSS_ICRU(E0,q,m,Thickness,Everlust) +c ===================================================== + +c Einheiten: +c ---------- +c Energie: [E0] = keV +c Ladung: [q] = e +c Masse: [m] = keV/c**2, wird auf m(Proton) umgerechnet +c Foliendicke [Thickness] = ug/cm**2 ! => 'masse' +c Energieverlust [Everlust] = keV + + IMPLICIT NONE + + real E0,EVerlust ! Startenergie und Energieverlust + real E,q,m,masse,Thickness ! Energie,Masse,Ladung,Foliendicke + real x ! aktuelle Position in der Folie + real dx ! Vorgabe fuer Dickenschritt + COMMON /ELoss_Ex/ E,x + COMMON /ELoss_masse / masse + + integer steps ! Nummer des aktuellen Integrationsschrittes + integer maxSteps /2000/ ! maximal tolerierte Anzahl an Schritten + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ueberpruefen ob (q.EQ.+1), sonst macht diese Energieverlustberechnung keinen +c Sinn: + + if (q.NE.1) then + write(*,*) + write(*,*) 'SUBROUTINE CALC_ELOSS_ICRU: Teilchenladung q = ',q + write(*,*) + write(*,*) 'Berechnung des Energieverlustes aus Protonendaten nur' + write(*,*) 'fuer Teilchen mit Ladungszahl q = +1 implementiert' + write(*,*) + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c Startwerte setzen: + + masse = m / 938272.3 ! Umrechnen in Protonenmassen + E = E0 ! aktuelle Energie auf Startenergie setzen + x = 0. ! Wir beginnen auf der Folienforderseite + dx = .05 ! Dring beim ersten Versuch 0.05 Mikrogramm/cm**2 in + ! die Folie ein + steps = 0. ! Zaehler fuer Anzahl der Integrationsschritte resetten + +c............................................................................... +c hierher wird zurueckgesprungen, solange Folienende noch nicht erreicht ist. + +10 if (x+dx.GT.Thickness) dx = Thickness-x ! Schritt erreicht Folienende + Steps = Steps + 1 + call INTEGRATION_ELOSS(dx) + + if (x.EQ.Thickness) then + EVerlust = E0 - E +c write(*,*) 'Ein, ELoss = ',E0,EVerlust +c write(*,'(A,i4,A)') ' calculation of ''ELOSS'' needed ',steps,' steps' + RETURN + elseif (x.GT.Thickness+1.E-5) then + EVerlust = E0 - E + write(*,*) + write(*,*) 'SUBROUTINE CALC_ELOSS_ICRU: x > Foliendicke' + write(*,*) + write(*,*) 'x = ',x + write(*,*) 'Thickness = ',Thickness + write(*,*) 'x-Thickness = ',x-Thickness + write(*,*) 'E0 = ',E0 + write(*,*) 'E = ',E + write(*,*) 'EVerlust = ',EVerlust + write(*,*) 'maxSteps = ',maxSteps + write(*,*) 'steps = ',steps + write(*,*) + write(*,*) '-> STOP' + write(*,*) + STOP + elseif (Steps.GT.MaxSteps) then + write(*,*) + write(*,*) 'SUBROUTINE CALC_ELOSS_ICRU:' + write(*,*) + write(*,*) 'Berechnung des Energieverlustes nicht innerhalb der erlaubten' + write(*,*) 'Maximalzahl an Schritten vollendet:' + write(*,*) + write(*,*) 'steps = ',steps + write(*,*) 'maxSteps = ',maxSteps + write(*,*) 'x = ',x + write(*,*) 'Thickness = ',Thickness + write(*,*) 'Thickness-x = ',Thickness-x + write(*,*) + write(*,*) '-> STOP' + write(*,*) + STOP + else + goto 10 + endif + + END + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATION_ELOSS(dx) +c ================================ + + IMPLICIT NONE + SAVE + +c Diese Subroutine berechnet zu einem vorgegebenen Dickenschritt dx den +c Energieverlust zweimal: einmal direkt mit dx und einmal ueber zwei +c aufeinanderfolgende Schritte mit dx/2. (die beiden dx/2-Schritte werden +c zuerst ausgefuehrt). +c +c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler +c des dx-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der +c Integrationsschritt mit einem verkuerzten Dickenintervall wiederholt werden +c muss, oder ob das Dickenintervall fuer den folgenden ausgedehnt werden kann. +c +c Die beiden Einzelergebnisse aus dem dx- und den beiden dx/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 dx zu erhalten. +c +c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL +c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta'. + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + real E ! aktuelle Energie bei Aufruf und + ! Verlassen der Routine + real x ! aktuelle Position in der Folie + COMMON /ELoss_Ex/ E,x + + logical log_relativ /.false./ ! relative Fehlerbetrachtung? + real eps /1e-8/ ! verlangte Genauigkeit des einzelnen + ! Integrationsschrittes + real dxsmall /.001/ ! minimale Dickenaenderung + integer n_dxSmall ! wie oft wurde dxSmall unterschritten + integer maxBelowDxSmall / 50 / ! max. tolerierte Anzahl an Unterschr. + + + real dx ! Dickenschritt + real dx_half ! halber Dickenschritt + real dE_dx_0,dE_dx_1 ! Stoppingpower + real E1,DE1,DE2 ! fuer Energieintegration + + real EDifferenz ! fuer Fehlerbetrachtung + real Error ! fuer Fehlerbetrachtung + + real errCon, safety ! fuer Schrittweitensteuerung + real pShrink, pGrow ! fuer Schrittweitensteuerung + + PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz + PARAMETER (pShrink = -.25, pGrow = -.2) + ! errCon = (4./safety)**(1/pGrow) + + logical flag_dxSmall ! wenn bei dx < dxsmall der Fehler + ! immer noch zu gross ist. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + flag_dxSmall = .false. ! flag resetten + +c Lese stopping power bei aktueller Energie. Speichere sie in dE_dx_0, damit sie +c wiederverwendet werden kann, falls die Berechnung mit kuerzerem Dickenschritt +c wiederholt werden muss. + + call stoppingPower(E,dE_dx_0) + + +c............................................................................... +10 continue ! hier gehts wieder von vorne los, falls Dickenschritt dx + ! abgeaendert werden muss. + + + dx_half = dx / 2. + + +c mache ersten dx/2 - Schritt: + + call RK4_ELOSS(dx_half,E,dE_dx_0,DE1) + + +c Lese stopping power bei Energie E1=E+DE1 und mache zweiten dx/2 - Schritt: + + E1 = E+DE1 + call stoppingPower(E1,dE_dx_1) + call RK4_ELOSS(dx_half,E1,dE_dx_1,DE2) + + +c Summiere Energieverluste der beiden dx/2 -Schritte und speichere in DE1: + + DE1 = DE1 + DE2 + + +c mache dx - Schritt: + + call RK4_ELOSS(dx,E,dE_dx_0,DE2) + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +C Fehlerbetrachtung: der groesste (absolute bzw. relative) Fehler soll kleiner +C als eps sein: + + Error = 0. + + EDifferenz = DE1-DE2 + if (log_relativ) then + if (DE1.NE.0.) then + Error = Abs( EDifferenz/DE1 ) + elseif (DE2.NE.0.) then + Error = Abs( EDifferenz/DE2 ) + endif + else + Error = Abs( EDifferenz ) + endif + + +c - Skaliere Fehler auf Epsilon: + + Error = Error / eps + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Die Groesse des reskalierten 'Error' bestimmt, ob der Integrationsschritt +c mit kleinerem Dickenintervall wiederholt werden muss, bzw. um welchen +c Faktor das Dickenintervall fuer den naechsten Schritt vergroessert werden +c kann: + +c Liegt der Fehler ausserhalb des Toleranzbereiches und ist dx bereits jetzt +c kleiner als dxsmall, so mache keinen neuen Versuch sondern akzeptiere als Not- +c loesung den bestehenden Naeherungswert. Setze dx in diesem Fall als Default +c fuer den kommenden Integrationsschritt auf dxsmall. Setze aber auch das flag +c 'flag_dxsmall', damit gezaehlt werden kann, wie oft dieses Prozedur angewendet +c werden muss. Ist dies zu oft der Fall, so brich die Berechnung ganz ab. +c (2. Teil erfolgt weiter unten) + + if (Error.GT.1.) then + if (dx.LT.dxsmall) then ! Fehler immer noch zu gross, obwohl + flag_dxsmall = .true. ! dxsmall schon unterschritten ist + else + !c Bestimme kuerzeren Dickenschritt fuer neuen Versuch (vgl. Referenz): + dx = safety * dx * (Error**pShrink) + goto 10 + endif + endif + + +c Nimm die Ergebnisse aus dem dx-Schritt und den beiden dx/2-Schritten und +c berechne damit den Energieverlust mit Genauigkeit fuenfter Ordnung in dx: + + E = E + DE1 + EDifferenz / 15. + + +c alten Dickenschritt addieren, neuen so gross wie sinnvoller weise moeglich +c machen: + + x = x + dx + if (flag_dxSmall) then + if (n_dxsmall.LT.maxBelowdxSmall) then + dx = dxSmall ! fuer naechsten RK-Schritt + n_dxsmall = n_dxsmall + 1 + else + write(*,*) 'n_dxSmall ueberschritten! -> STOP' + STOP + endif + else + if (Error.GT.errCon) then + dx = safety * dx * (Error**pGrow) ! vgl. Referenz + else + dx = 4. * dx ! <- Vergroesserung des Dickenschritts max. um + endif ! Faktor 4! + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE RK4_ELOSS(dx_,EIn,dE_dx_0,DE) +c ======================================== + + IMPLICIT NONE + SAVE + +c Diese Subroutine berechnet bei vorgegebenem Dickenschritt 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'. Die Formeln sind zwar teilweise +c etwas umgeschrieben, sind aber mathematisch alle aequivalent zu denen der +c Referenz. + +c Zurueckgegeben wird die errechnete Energieaenderung anstatt direkt des neuen +c Wertes, da sonst Schwierigkeiten auftreten koennen, wenn in der Subroutine +c 'INTEGRATIONSSTEP_ELOSS' aus der Differenz der neuen Werte aus den beiden +c dx/2- und dem dx-Schritt der Fehler abgeschaetzt werden soll (kleine +c Differenz moeglicherweise grosser Werte). + + real dE_dx_0, EIn ! Eingangsgroessen + real dx_,dx_half_ ! Dickenschritt, halber Dickenschritt + real DE ! Ergebnisspeicher + + real Test_E ! Test-Energie + real dE_dx_1,dE_dx_2,dE_dx_3 ! Stoppingpower bei Test-Energien + + +c First step of Runge-Kutta-Method: + + dx_half_ = dx_ / 2. + Test_E = EIn + dE_dx_0 * dx_half_ + + +c Second step of Runge-Kutta-Method: + + call stoppingPower(Test_E,dE_dx_1) + Test_E = EIn + dE_dx_1 * dx_half_ + + +c Third step of Runge-Kutta-Method: + + call stoppingPower(Test_E,dE_dx_2) + Test_E = EIn + dE_dx_2 * dx_ + + +c Fourth step of Runge-Kutta-Method: + + call stoppingPower(Test_E,dE_dx_3) + + +c calculate forward step: + + DE = (dE_dx_0 + 2.*(dE_dx_1+dE_dx_2) + dE_dx_3) * dx_/6. + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE stoppingPower(E_,dE_dx) +c ================================= + + IMPLICIT NONE + + real E_,dE_dx,StoPo_ + + integer DatenZahl + parameter (DatenZahl=56) + + real E(DatenZahl) + real StoPoGr(DatenZahl) ! fuer Graphit + real StoPoAK(DatenZahl) ! fuer amorphen Kohlenstoff + + real Ep ! Energie von Protonen mit gleicher Geschwindigkeit + real masse ! Masse der Teilchen in Protonenmassen + COMMON /ELoss_masse / masse + + integer i + + logical graphitData + common /elossDataType/ graphitData + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zu den Einzelbeitraegen von Elektronen und Kernen vergleiche die Programme +c NUCL_AND_EL_STOP_AMORPH.FOR und NUCL_AND_EL_STOP_GRAPHIT.FOR im directory +c UD0:[SIMULA.PROGRAMS.ICRU-ELOSS] auf der SLOMU in Konstanz. +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c +c Die Daten sind aus dem ICRU Report 49 entnommen: +c +c ICRU Report 49: 'Stopping Powers and Ranges for Protons and Alpha Particles' +c Signatur PSI-Bibliothek West: 850 B 1:49 +c Tabelle Seite 112: PROTONS IN CARBON (Graphite, density 1.7 g/cm^3) +c Spalte: TOTAL STOPPING POWER (= electronic plus nuclear) + + DATA E / 0., + + 001,001.5,002,002.5,003,004,005,006,007,008,009, + + 010,012.5,015,017.5,020,022.5,025,027.5,030,035,040, + + 045,050,055,060,065,070,075,080,085,090,095, + + 100,125,150,175,200,225,250,275,300,350,400, + + 450,500,550,600,650,700,750,800,850,900,950 / + +c Die hier aufgelisteten Werte sind um Faktor 10000. zu gross. -> Wird unten +c reskaliert. + +c Dies sind die totalen Stoppingpowerdaten fuer Graphit! +c Diese wurden bis Version 1.5.6 von Mutrack ausschliesslich verwendet. + + DATA StoPoGr / 0., + + 1677,1963,2214,2443,2652,2958,3241,3500,3738,3946,4132, + + 4303,4678,4991,5264,5510,5731,5927,6101,6259,6551,6823, + + 7067,7274,7441,7574,7677,7755,7810,7845,7861,7860,7846, + + 7819,7548,7153,6721,6297,5908,5561,5254,4982,4543,4196, + + 3906,3654,3433,3240,3073,2925,2793,2675,2568,2470,2380 / + +c Dies sind die totalen Stoppingpowerdaten fuer amorphen Kohlenstoff! + + DATA StoPoAK / 0., + + 1635,1906,2140,2351,2544,2826,3086,3323,3541,3730,3899, + + 4055,4393,4675,4919,5140,5338,5512,5666,5806,6066,6307, + + 6523,6706,6854,6970,7061,7129,7178,7208,7221,7222,7209, + + 7185,6955,6619,6254,5897,5566,5265,4996,4755,4362,4048, + + 3782,3549,3343,3162,3004,2864,2739,2626,2524,2429,2343 / + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (E_.LT.0) then + write(*,*) + write(*,*) 'error in subroutine ''STOPPINGPOWER'':' + write(*,*) 'E_ = ',E_,' < 0!' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + +c Energie auf diejenige Energie reskalieren, die ein Proton haette, wenn es +c sich mit der gleichen Geschwindigkeit bewegen wuerde, wie das Teilchen der +c Masse 'masse', das sich mit der Energie 'E_' bewegt: + + Ep = E_/masse ! masse ist in Protonenmassen angegeben + + +c suche zustaendige Stelle in der Tabelle: + + do i = 1, DatenZahl + if (E(i).GE.Ep) goto 10 + enddo + write(*,*) + write(*,*) 'error in subroutine ''STOPPINGPOWER'': Ep > Ep_max' + write(*,*) '-> STOP' + write(*,*) + STOP + + +10 continue + +c Berechne die Stoppingpower (ueber lineare Interpolation): + + if (i.lt.2) then + write(*,*) 'i = ',i + STOP + endif + if (graphitData) then + StoPo_ = StoPoGr(i-1) + (StoPoGr(i)-StoPoGr(i-1))*(Ep-E(i-1))/(E(i)-E(i-1)) + else + StoPo_ = StoPoAK(i-1) + (StoPoAK(i)-StoPoAK(i-1))*(Ep-E(i-1))/(E(i)-E(i-1)) + endif + dE_dx = - StoPo_ / 10000. ! negativieren und reskalieren + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE E_Straggling_Yang(mean_E,m,sigmaEloss) +c ================================================= + + IMPLICIT NONE + +c Dieses Routine berechnet die Energieverluststreuung fuer einfach geladenen +c Teilchen in der Kohlenstofffolie entsprechend den empirischen Formeln von +c Q. Yang: "Empirical formulae for energy loss straggling of ions in matter", +c Q. Yang, D.J. O'Connor, Y. Wang, NIM B61, S. 149-155 (1991) + +c Eingabeparameter: Foliendicke, Teilchenart und Eingangsenergie. +c Ausgabegroesse: Energieverluststraggling + +c Einheiten: +c ---------- +c Energie: [E0] = keV +c Ladung: [q] = e +c Masse: [m] = keV/c**2, wird auf m(Proton) umgerechnet +c Foliendicke [Thickness] = ug/cm**2 ! => 'masse' +c Straggling: [sigmaEloss] = keV + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real mean_E ! mittlere Energie in Folie + real m ! Masse + real mean_Ep ! mean_E umgerechnet auf Protonenmasse + ! (fuer sigmaE = 0) + real sigmaEloss ! Energieverluststreuung (Ausgabevariable) +c real sigmaInhom ! Streuung aufgrund von Dickeninhomog. + + real Z2 + parameter (Z2 = 6.) ! Kernladungszahl von Kohlenstoff + + real factor_Thickness ! fuer Umrechnung von ug/cm**2 + parameter (factor_Thickness=6.022e23/12.011e6) ! in Atome/cm**2 + ! 6.022e23: Avogadrokonstante + ! 12.011e6: molare Masse in ug. + + real eSquare ! fuer Umrechnung in SI-System + parameter (eSquare = 1.44e-10) ! keV*cm + + real fourPi + parameter (fourPi = 12.56637061) + + real factor_Bohr ! fuer Berechnung der Streuung nach Bohr + parameter (factor_Bohr = fourPi*Z2*eSquare*eSquare*factor_Thickness) + + real OmQuad, OmQuadBohr + real OmQuad_over_OmQuadBohr + real DOmQuad_over_OmQuadBohr + real OmQuadChu_over_OmQuadBohr + real Gamma, rHelp + + real A1,A2,A3,A4 + parameter (A1 = -0.5127, A2 = -0.8595, A3 = 0.5626, A4 = -0.8721) + + real B1,B2,B3,B4 + parameter (B1 = 0.1955, B2 = 0.6941, B3 = 2.522, B4 = 1.040) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Umrechnen der Energie auf Protonenenergie in MeV: + + mean_Ep = mean_E * 938272.6/m / 1000. ! mean_Ep in MeV !!! + + +c Berechnen der Streuung: + + ! Streuung nach Bohr: + OmQuadBohr = factor_Bohr * Thickness + + ! Streuung nach Chu: + OmQuadChu_over_OmQuadBohr = 1. / (1. + A1*mean_Ep**A2 + A3*mean_Ep**A4) + + ! Streuung nach Yang: + Gamma = B3 * (1. - exp(-B4*mean_Ep)) + rhelp = mean_Ep - B2 + DOmQuad_over_OmQuadBohr = B1*Gamma / (rHelp*rHelp + Gamma*Gamma) + + ! Gesamtresultat: + OmQuad_over_OmQuadBohr = OmQuadChu_over_OmQuadBohr + DOmQuad_over_OmQuadBohr + OmQuad = OmQuad_over_OmQuadBohr * OmQuadBohr + + +c Folieninhomogenitaeten beruecksichtigen: + +c OmQuad = OmQuad + (sigmaInhom * sigmaInhom) + + +c Endgueltige Energiestreuung: + + sigmaEloss = SQRT(OmQuad) + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE E_Straggling_Lindhard(mean_E,m,sigmaEloss) +c ===================================================== + + IMPLICIT NONE + +c Dieses Routine berechnet die Energieverluststreuung fuer einfach geladenen +c Teilchen in der Kohlenstofffolie entsprechend den Formeln von J. Lindhard +c und M. Scharff + +c Eingabeparameter: Foliendicke, Teilchenart und Eingangsenergie. +c Ausgabegroessen: Energieverluststraggling + +c Einheiten: +c ---------- +c Energie: [E0] = keV +c Ladung: [q] = e +c Masse: [m] = keV/c**2, wird auf m(Proton) umgerechnet +c Foliendicke [Thickness] = ug/cm**2 ! => 'masse' +c Straggling: [sigmaEloss] = keV + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real mean_E ! mittlere Energie in Folie + real m ! Masse, Foliendicke + real sigmaEloss ! Energieverluststreuung (Ausgabevariable) +c real sigmaInhom ! Streuung aufgrund von Dickeninhomog. + + real sigmaQuad + real help,L_y,y ! Fuer Berechnung der Lindhard-Scharff Korrektur + real v_over_v0_Quad + + real fourPi + parameter (fourPi = 12.56637061) + + real Z2 + parameter (Z2 = 6.) ! Kernladungszahl von Kohlenstoff + + real factor_v0Quad ! fuer Geschwindigkeitsskalierung auf v0 + parameter (factor_v0Quad = 37574.632) ! (Bohrgeschwindigkeit) + ! = 1/(13.6eV/me) , me in keV/c**2 eingesetzt + + real factor_Thickness ! fuer Umrechnung von ug/cm**2 + parameter (factor_Thickness=6.022e23/12.011e6) ! in Atome/cm**2 + ! 6.022e23: Avogadrokonstante + ! 12.011e6: molare Masse in ug. + + real eSquare ! fuer Umrechnung in SI-System + parameter (eSquare = 1.44e-10) ! keV*cm + + real factor_Bohr ! fuer Berechnung der Streuung nach Bohr + parameter (factor_Bohr = fourPi*Z2*eSquare*eSquare*factor_Thickness) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Sigma nach Bohr berechnen: + + sigmaQuad = factor_Bohr * Thickness + +c Korrektur nach Lindhard & Scharff beruecksichtigen: + + v_over_v0_Quad = mean_E/m * factor_v0Quad + y = v_over_v0_Quad / Z2 + + if (y.LT.3.) then + help = SQRT(y) + L_y = 1.36 * help - .016 *help*help*help + sigmaQuad = sigmaQuad * L_y / 2. + endif + +c Folieninhomogenitaeten beruecksichtigen: + +c sigmaQuad = sigmaQuad + (sigmaInhom * sigmaInhom) + + +c Endgueltige Energiestreuung berechnen: + + sigmaEloss = SQRT(sigmaQuad) + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INPUT.FOR b/mutrack/src/SUB_INPUT.FOR new file mode 100644 index 0000000..7c68b57 --- /dev/null +++ b/mutrack/src/SUB_INPUT.FOR @@ -0,0 +1,3017 @@ +c - Zuweisungen fuer 'dx5' und 'gridInFrontOfFoil' vielleicht besser in +c 'geo_kammer.input' verlegen! +c - Zuweisung fuer 'dx5' fuer Run10 ist noch zu pruefen! (15mm richtig?) +c - bei Use_MUTRACK und use_ACCEL pruefen lassen, ob verwendete Geometrien +c kompatibel sind (damit naechste Simulation wirklich dort weiterrechnet, +c wo die andere aufgehoert hat (gegebenenfalls bei verschiedenen Runs +c Bestaetigung einholen) +c - bei 'createFoilFile' alle Schleifen die raeumlich nach der Triggerfolie +c liegen auf 0,-1e10,1e10 (oder entsprechend) setzen, damit diese +c ungenutzten Schleifen nur einmal durchlaufen werden! +c - kann Text zwischen 'Marke 1' und 'Marke 2' nicht mit vorherigen Passagen +c bzgl. des Triggerdetektors zusammengefasst werden? (Vielleicht nicht!) +c------------------------------------------------------------------------------- + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE read_inputFile +c ========================= + + IMPLICIT NONE + +c Diese Subroutine liest das Eingabe-file 'MUTRACK.INPUT' und stellt +c die Simulationsparameter fuer das Programm entsprechend ein. Die Parameter +c befinden sich alle in einem COMMON-Block und sind so im gesamten Programm +c vorhanden. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c name-lists: + +c - /acVersion/: + + namelist /acVersion/ accelVersion + +c - /muVersion/: + + namelist /muVersion/ mutrackVersion,accelVersion + +c - /loop_params/: +c diese Variablen sind zwar auch in der nameList /parameter_liste/ enthalten, +c werden hier aber noch einmal separat gefuehrt fuer das Einlesen der +c Schleifensettings von ACCEL bzw. vom 'foilfile': + + namelist /loop_params/ + + U_Tgt_,U_Gua_,U_G1_,U_L1_,U_Sp_,U_L2_,U_Folie_, B_Helm_,B_TD_, + + alfaTgt_,alfaSp_,alfaTD_,Masse_,Ladung_, + + E0_,y0_,z0_,theta0_,phi0_,deltaL1_ +c nur fuer das Einlesen aelterer foilFile-Versionen: + + ,U_KL_ + +c - /parameter_liste/: + +c (Die Variablen +c randomStarts_prevSim, artList_prevSim, +c E0InterFromFile, UseDecay_prevSim, +c +c sind nicht fuer die Dateneinlesung aus MUTRACK.INPUT sondern werden fuer das +c Einlesen der INFO-Files von ACCEL bzw. einer frueheren 'foilFile'-MUTRACK- +c Rechnung benoetigt. 'useDecay_AH', 'artList_AH' und 'randomStarts_AH' sind +c die Vorgaenger der jetztigen Variablen mit den 'prevSim'-Endungen und +c und sind nur noch fuer das Einlesen aelterer Infofiles vorhanden. Sie koennen +c in der Zukunft problemlos entfernt werden). + + namelist /parameter_liste/ + + + TestRun,Startflaeche,x0_,KammerTeil,alfaTgtVertically, + + + randomStarts,randomStarts_prevSim, random_energy,lowerE0,upperE0,sigmaE0, + + random_position,StartBreite,StartHoehe,StartRadius,sigmaPosition, + + random_winkel,StartLambertOrd,SigmaWinkel, + + + U_Tgt_,U_Gua_,U_G1_,U_L1_,U_Sp_,U_L2_,U_L3_,U_Folie_,U_Vorne_,U_Hinten_, + + U_MCP3_,U_MCP2_,alfaTgt_,alfaSp_,alfaTD_, B_Helm_,B_TD_, Masse_,Ladung_, + + E0_,y0_,z0_,theta0_,phi0_,thickness_,mean_Eloss_,deltaL1_,deltaL2_, + + E0InterFromFile, + + + artList,artList_prevSim, + + TriggerInBeam, n_aufstreu,sigmaAufstreu, + + n_E_Verlust,calculate_each,sigmaE,lowerE,upperE,graphitData, + + log_neutralize,neutral_fract,TransTDFoil,generate_FE, + + GridInFrontOfFoil, + + + UseDecay, UseDecay_prevSim, TestOnWireHit, + + previousSimulation,previousSettings, + + fileName_ACCEL,fileName_Mutrack, + + createFoilFile,upToTDFoilOnly, + + + Fo_triggered,xM2_triggered,M2_triggered, + + + idealMirror, + + geo_filename,write_geo,xBlende,radius_Blende, + + + DEBUG,DEBUG_Anzahl, DEBUG_FE, + + GRAPHICS,GRAPHICS_Anzahl, plot_FE, n_postSkript, iMonitor, + + color,schnitt_x,schnitt_p,log_marker,vertical, + + + n_outWhere, + + log_out_FE, log_out_pfosten, + + SUM_S1xM2,SUM_S1M2,SUM_S1Fo,SUM_FoM2,SUM_S1M3,SUM_M3M2,SUM_t_FE, + + SUM_y_Fo,SUM_z_Fo,SUM_r_Fo,SUM_y_M2,SUM_z_M2,SUM_r_M2,SUM_y_xM2, + + SUM_z_xM2,SUM_r_xM2, + + + TAB_S1xM2,TAB_S1M2,TAB_S1Fo,TAB_FoM2,TAB_S1M3,TAB_M3M2,TAB_t_FE, + + TAB_y_Fo,TAB_z_Fo,TAB_r_Fo,TAB_y_M2,TAB_z_M2,TAB_r_M2,TAB_y_xM2, + + TAB_z_xM2,TAB_r_xM2, + + + createPhysTab, + + PHY_S1xM2,PHY_S1M2,PHY_S1Fo,PHY_FoM2,PHY_S1M3,PHY_M3M2,PHY_t_FE, + + PHY_y_Fo,PHY_z_Fo,PHY_r_Fo,PHY_y_M2,PHY_z_M2,PHY_r_M2,PHY_y_xM2, + + PHY_z_xM2,PHY_r_xM2, + + PHY_mean,PHY_variance,PHY_minimum,PHY_maximum,PHY_percent, + + + createNTP, + + NTP_charge,NTP_S1xM2,NTP_times,NTP_FoM2Only,NTP_lifetime,NTP_start, + + NTP_stop,NTP_40mm,NTP_Folie,NTP_steps, smearS1Fo,sigmaS1Fo, + + + eps_x,eps_v,log_relativ, maxStep, dtsmall,maxBelowDtSmall, + +d + dl_max_L1,dl_max_Sp,dl_max_L2andFo,dl_max_Fo,dl_max_L3,dl_max_M2, log_confine, + + + ow_U_Tgt,ow_U_Gua,ow_U_G1,ow_alfaTgt, + + ow_masse,ow_ladung,ow_E0,ow_y0,ow_z0,ow_theta0,ow_phi0, + + ow_U_L1,ow_U_Sp,ow_U_L2,ow_U_Folie, ow_B_Helm,ow_B_TD, + + ow_alfaSp,ow_alfaTD,ow_deltaL1,ow_artList, writeTraj2File, + + + seed_, + + + useDecay_AH, artList_AH, randomStarts_AH + + +c fuer Kompatibilitaet mit frueheren Versionen, bei denen statt der Extension +c '_prevSim' noch die Extension '_AH' verwendet wurde: + + logical useDecay_AH /.false./ + character artList_AH*50 / ' ' / + integer randomStarts_AH / -1E8 / + + +c - /KAMMER_GEO/: + + namelist /kammer_geo/ + + + radius_Rohr, + + xtarget,dytarget,dztarget, ! Beim Einlesen sind xGrid1 und + + xgrid1,dygrid1,dzgrid1, ! xGrid2 relativ zur Targetfolie, + + dWires_G1,dist_Wires_G1, ! im Programm relativ zur Kryo- + + xgrid2,dygrid2,dzgrid2, ! achse gemessen + + dWires_G2,dist_Wires_G2, + + rHeShield,dyHeShield,dzHeShield, + + rLNShield,dyLNShield,dzLNShield, + + xCenterOfLense_L1,MappenName_L1, + + xSpiegel,DreharmLaenge,BSpiegel,hSpiegel,DSpiegel,MappenName_Sp, + + dWires_Sp,dist_Wires_Sp, + + xCenterOfLense_L2,MappenName_L2andFo, + + xTD,mappenName_Fo, + + xCenterOfLense_L3,MappenName_L3, + + xMCP2,radius_MCP2active,MappenName_M2 + +c------------------------------------------------------------------------------- + + INCLUDE 'mutrack$SOURCEdirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + character*40 inputName /'MUTRACK.INPUT'/ + COMMON /inputName/ inputName + + integer k ! Zaehlvariable + logical flag + logical flag_message /.false./ + real help + integer ihelp + character antwort*5 + + logical log_marker / .false./ ! Marker am Ende der Trajektorien + COMMON /marker/ log_marker ! zeichen? + + integer previousSimulation !/0/ + + logical ow_U_Tgt /.false./ + logical ow_U_Gua /.false./ + logical ow_U_G1 /.false./ + logical ow_alfaTgt /.false./ + logical ow_masse /.false./ + logical ow_ladung /.false./ + logical ow_E0 /.false./ + logical ow_y0 /.false./ + logical ow_z0 /.false./ + logical ow_theta0 /.false./ + logical ow_phi0 /.false./ + logical ow_U_L1 /.false./ + logical ow_U_Sp /.false./ + logical ow_U_L2 /.false./ + logical ow_U_Folie /.false./ + logical ow_B_Helm /.false./ + logical ow_B_TD /.false./ + logical ow_alfaSp /.false./ + logical ow_alfaTD /.false./ + logical ow_deltaL1 /.false./ + logical ow_artList /.false./ + + +c lokale Variablen fuer die Gewinnung von VersionIndxAC bzw. VersionIndxMU: + + integer version1,version2,version3 + integer pos1,pos2 + + +c Variablen im Zusammenhang mit den Eingabefile-Listen 'LISTn.INPUT': + + integer lastOne /0/, fileNr, iostat, length + logical testRun_ + character datum*9,uhrzeit*8 + + +c die lokalen Variablen zur Festlegung des Startortes und -Gebietes: + + real x0_ / 0. / ! StartKoordinate + integer Kammerteil / 1 / ! Start-Kammerteil + + +c die lokal definierten Groessen zur Festlegung der Zufallsverteilungen der +c Startparameter: + + integer random_energy / 0 / ! welche Verteilung fuer Startenergie? + integer random_position / 0 / ! welche Verteilung fuer Startposition? + integer random_winkel / 0 / ! welche Verteilung fuer Startwinkel? + + integer randomStarts / 50/ + integer seed_ / 0 / + + +c die lokalen Variablen fuer die Festlegung der Zufallsverteilungen fuer +c Energie- und Winkelaufstreuung in der Triggerfolie: + + integer n_E_Verlust / 0 / ! Art der Beruecksichtigung des Energie- + ! verlustes in der Triggerfolie + integer n_Aufstreu / 0 / ! Art der Beruecksichtigung der Winkel- + ! Aufstreuung in der Triggerfolie + + +c die lokalen Felder der 'Schleifenparameter'. Die Felder werden dann in das +c Feld 'par' uebertragen: + + ! von ! bis ! step ! + real U_Tgt_(3) / 0. , +1.e10 , -1.e10 / + real U_Gua_(3) / -1.e10 , +1.e10 , -1.e10 / + real U_G1_(3) / 0. , +1.e10 , -1.e10 / + real U_L1_(3) / 0. , +1.e10 , -1.e10 / + real U_Sp_(3) / 0. , +1.e10 , -1.e10 / + real U_L2_(3) / 0. , +1.e10 , -1.e10 / + real U_L3_(3) / 0. , +1.e10 , -1.e10 / + +c Fuer das Einlesen aelterer foilFile-Versionen: + real U_KL_(3) / -1.e10 , +1.e10 , -1.e10 / + + real U_Folie_(3) / 0. , +1.e10 , -1.e10 / + real U_Vorne_(3) / 0. , +1.e10 , -1.e10 / + real U_Hinten_(3) / 0. , +1.e10 , -1.e10 / + real U_MCP3_(3) / 0. , +1.e10 , -1.e10 / + + real U_MCP2_(3) / 0. , +1.e10 , -1.e10 / + + real B_Helm_(3) / 0. , +1.e10 , -1.e10 / + real B_TD_(3) / 0. , +1.e10 , -1.e10 / + + real alfaTgt_(3) / 0. , +1.e10 , -1.e10 / + real alfaSp_(3) / 45. , +1.e10 , -1.e10 / + real alfaTD_(3) / 0. , +1.e10 , -1.e10 / + + real Masse_(3) / 105659. , +1.e10 , -1.e10 / + real Ladung_(3) / 1. , +1.e10 , -1.e10 / + + real E0_(3) / 0. , +1.e10 , -1.e10 / + real y0_(3) / 0. , +1.e10 , -1.e10 / + real z0_(3) / 0. , +1.e10 , -1.e10 / + real theta0_(3) / 0. , +1.e10 , -1.e10 / + real phi0_(3) / 0. , +1.e10 , -1.e10 / + + real thickness_(3) / 0. , +1.e10 , -1.e10 / + real mean_Eloss_(3) / 0. , +1.e10 , -1.e10 / + + real deltaL1_(3) / 0. , +1.e10 , -1.e10 / + real deltaL2_(3) / 0. , +1.e10 , -1.e10 / + + +c Defaultwerte fuer Restaurierung: + + real defVal(3) / 0. , +1.e10 , -1.e10 / + + +c die lokal definierten logicals fuer die Festlegung der im LOG-file auszu- +c gebenden Statistiken. Die Logicals werden dann in das Feld 'statInSummary' +c uebertragen: + + logical SUM_S1xM2 / .false. / + logical SUM_S1M2 / .false. / + logical SUM_S1Fo / .false. / + logical SUM_FoM2 / .false. / + logical SUM_S1M3 / .false. / + logical SUM_M3M2 / .false. / + logical SUM_t_FE / .false. / + logical SUM_y_Fo / .false. / + logical SUM_z_Fo / .false. / + logical SUM_r_Fo / .false. / + logical SUM_y_M2 / .false. / + logical SUM_z_M2 / .false. / + logical SUM_r_M2 / .false. / + logical SUM_y_xM2 / .false. / + logical SUM_z_xM2 / .false. / + logical SUM_r_xM2 / .false. / + + + +c die lokal definierten logicals fuer die Festlegung der fuer PHYSICA abzu- +c speichernden Statistiken. Die Logicals werden dann in das Feld 'statInPHYSICA' +c uebertragen: + + logical PHY_S1xM2 / .false. / + logical PHY_S1M2 / .false. / + logical PHY_S1Fo / .false. / + logical PHY_FoM2 / .false. / + logical PHY_S1M3 / .false. / + logical PHY_M3M2 / .false. / + logical PHY_t_FE / .false. / + logical PHY_y_Fo / .false. / + logical PHY_z_Fo / .false. / + logical PHY_r_Fo / .false. / + logical PHY_y_M2 / .false. / + logical PHY_z_M2 / .false. / + logical PHY_r_M2 / .false. / + logical PHY_y_xM2 / .false. / + logical PHY_z_xM2 / .false. / + logical PHY_r_xM2 / .false. / + + +c die lokal definierten logicals fuer die Festlegung der fuer PHYSICA abzu- +c speichernden statistischen Groessen. Die Logicals werden dann in das Feld +c 'whatInPHYSICA' uebertragen: + + logical PHY_mean / .false. / + logical PHY_variance / .false. / + logical PHY_minimum / .false. / + logical PHY_maximum / .false. / + logical PHY_percent / .false. / + + +c die lokal definierten logicals fuer die Festlegung der zu erzeugenden +c Tabellenfiles. Die Logicals werden dann in das Feld 'createTabelle' ueber- +c tragen: + + logical TAB_S1xM2 / .false. / + logical TAB_S1M2 / .false. / + logical TAB_S1Fo / .false. / + logical TAB_FoM2 / .false. / + logical TAB_S1M3 / .false. / + logical TAB_M3M2 / .false. / + logical TAB_t_FE / .false. / + logical TAB_y_Fo / .false. / + logical TAB_z_Fo / .false. / + logical TAB_r_Fo / .false. / + logical TAB_y_M2 / .false. / + logical TAB_z_M2 / .false. / + logical TAB_r_M2 / .false. / + logical TAB_y_xM2 / .false. / + logical TAB_z_xM2 / .false. / + logical TAB_r_xM2 / .false. / + + +c Defaultwerte fuer dl_max_..: + + DATA dl_max_L1 / 1.0 / + DATA dl_max_Sp / 1.0 / + DATA dl_max_L2andFo / 1.0 / + DATA dl_max_Fo / 1.0 / + DATA dl_max_L3 / 1.0 / + DATA dl_max_M2 / 1.0 / + +c ... + character*30 zeile + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + logical writeTraj2File + common /writeTraj2File/ writeTraj2File +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Variable fuer den Test, ob 'MUTRACK' als batch job laeuft: +c (setzt voraus, dass im Falle eines batch jobs das logical +c 'running_in_batchmode' definiert ist). + + INCLUDE '($SSDEF)/NOLIST' + INCLUDE '($LNMDEF)/NOLIST' + + integer status, sys$trnlnm + + STRUCTURE /ITMLST/ + UNION + MAP + integer*2 BUFLEN + integer*2 CODE + integer*4 BUFADR + integer*4 RETLENADR + END MAP + MAP + integer*4 END_LIST + END MAP + END UNION + END STRUCTURE + + RECORD /ITMLST/ LNMLIST(2) + + character*20 running_in_batchmode + + +c=============================================================================== + +c Pruefe, ob MUTRACK als batch job laeuft: + + LNMLIST(1).BufLen = Len(RUNNING_IN_BATCHMODE) + LNMLIST(1).Code = LNM$_STRING + LNMLIST(1).BufAdr = %Loc(RUNNING_IN_BATCHMODE) + LNMLIST(1).RetLenAdr = 0 + + Status = SYS$trnlnm(lnm$M_case_blind, + + 'lnm$file_dev','RUNNING_IN_BATCHMODE',,Lnmlist) + + if (Status.EQ.SS$_NOLOGNAM) then + batch_mode = .false. + else + write(*,*) + write(*,*) ' >>>> *******************************************' + write(*,*) ' >>>>> logical ''RUNNING_IN_BATCHMODE'' is defined' + write(*,*) ' >>>>> => assume MUTRACK is run in batch mode' + write(*,*) ' >>>> *******************************************' + write(*,*) + batch_mode = .true. + + +c Pruefe, of 'InputListName' definiert ist. Falls ja, verwende die entsprechende +c Eingabeliste. Ansonsten bearbeite MUTRACK.INPUT: + + LNMLIST(1).BufLen = Len(inputListName) + LNMLIST(1).Code = LNM$_STRING + LNMLIST(1).BufAdr = %Loc(inputListName) + LNMLIST(1).RetLenAdr = 0 + + Status = SYS$trnlnm(lnm$M_case_blind, + + 'lnm$file_dev','inputListName',,Lnmlist) + + if (Status.NE.SS$_NOLOGNAM) then + call str$trim(inputListName,inputListName,Length) + inputListName = inputListName(1:length) + INPUT_LIST = .true. + endif + + +c Liess gegebenenfalls zu verwendenden Input-filenamen ein: + + if (INPUT_LIST) then + open(lunRead,file=inputListName//'.INPUT',status='old',iostat=iostat, + + defaultfile=readDir) + if (iostat.NE.0) then + write(*,*) ' Kann '''//inputListName//'.INPUT'' nicht oeffnen' + write(*,*) + call exit + endif + + ListLength = 0 + testRun_ = .false. +10 read(lunRead,'(A)',end=20) inputName + read(inputName,*,iostat=iostat) ihelp + if (iostat.NE.0) then + ListLength = ListLength + 1 + goto 10 + else + if (ihelp.GT.0) then + lastOne = ihelp + if (lastOne.EQ.1) then + write(*,*) 'Es wurden schon alle files aus '''//inputListName//'.INPUT''' + write(*,*) 'abgearbeitet!' + write(*,*) + close(lunRead) + call exit + endif + else + gotFileNr = .true. + fileNr = -ihelp+1 + if (fileNr.EQ.10000) fileNr=9900 + endif + goto 10 + endif + +20 if (listLength.EQ.0) then + write(*,*) ' no file names found in inputList -> STOP' + call exit + endif + if (lastOne.EQ.0) lastOne=listLength+1 + + +c den Namen des fuer diese Simulation zu verwendenden input-files einlesen: + + rewind(lunRead) + do k = 1, lastOne-2 + read(lunRead,*) + enddo + read(lunRead,'(A)') inputName + + +c die Nummer des jetzt verwendeten input-files sowie (falls schon bekannt) die +c (negative) fileNr der Ausgabefile ausgeben: + + ! bis Listenende weiterblaettern: + do k = lastOne, listLength + read(lunRead,*) + enddo + write(lunRead,*) lastOne-1 + if (gotFileNr) write(lunRead,*) -fileNr + close(lunRead) + + +c gegebenenfalls schon den Namen der Ausgabe-files definieren: + + if (gotFileNr) then + if (fileNr.GE.9900) then + TestRun_ = .true. + else + TestRun_ = .false. + endif + write(filename(4:7),'(I4)')fileNr + if (fileNr.LE.999) write (filename(4:4),'(A1)') '0' + if (fileNr.LE. 99) write (filename(5:5),'(A1)') '0' + if (fileNr.LE. 9) write (filename(6:6),'(A1)') '0' + endif + + + write(*,'(xA,I3,A)')'Verwende',listLength-lastOne+2, + + '.letzte INPUT-Datei aus '''//inputListName//'.INPUT'': ' + write(*,*) inputName + + open(lunMessage,file='MU_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + write(lunMessage,'(xx,I2)',iostat=iostat) lastOne-1 + + + else + + open(lunMessage,file='MUTRACK.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + + endif + + call date(datum) + call time(uhrzeit) + write(lunMessage,*,iostat=iostat) ' started on '//datum//' at '//uhrzeit + write(lunMessage,*,iostat=iostat) inputname + close(lunMessage,iostat=iostat) + + endif + + +c------------------------------------------------------------------------------- + +c Defaultwerte fuer Kammergeometrie (da diese Variablen in 'COM_KAMMER' gefuehrt +c werden anstatt in COM_MUTRACK werden sie hier initialisert): + + DreharmLaenge = 0. + xBlende = -1. + + +c Einlesen der Eingabe-Datei 'MUTRACK.INPUT': + + open(lunREAD,file=inputName,defaultfile=readDir//':.INPUT', + + status='OLD',readonly) + read(lunREAD,nml=parameter_liste) + close(lunREAD) + + +c Einlesen der 'overwrite_default'-Datei: + + open(lunREAD,file='overwrite_defaults',defaultfile=readDir//':.INPUT', + + status='OLD',readonly,iostat=iostat) + if (iostat.EQ.0) then + write(*,*) ' ##### READING INPUT FROM FILE >> ''OVERWRITE_DEFAULTS.INPUT'' << #####' + read(lunREAD,nml=parameter_liste) + close(lunREAD) + endif + + if (previousSimulation.EQ.0) E0InterFromFile = .false. + + TransTDFoil = TransTDFoil/100. ! Umrechnen von Prozent in absolute Angabe + + write(*,*) + if (seed_.GT.0) then ! -> es wurde Startwert fuer seed vorgegeben + seed = seed_ + write(*,*) '''seed_'' was specified in MUTRACK.INPUT => not randomly thrown' + flag_message = .true. + if (seed.LT.1e6) then + write(*,*) '''seed'' has to be greater than 1E6' + call exit + endif + if ((seed/2)*2.EQ.seed) then + write(*,*) '''seed'' has to be an odd number => seed -> seed + 1' + seed = seed+1 + endif + endif + write(*,*) ' seed = ',seed + write(*,*) + + if (previousSimulation.EQ.1) then + use_ACCEL = .true. ! default = .false. + elseif (previousSimulation.EQ.2) then + use_MUTRACK = .true. ! default = .false. + NTP_40mm = .false. + endif + + if (NTP_Times) NTP_FoM2Only = .false. + if (createFoilFile) then + if (.NOT.TriggerInBeam) then + TriggerInBeam = .true. + write(*,*) '''createFoilFile'' = .true. -> set ''TriggerInBeam'' to ''.true.''' + flag_message = .true. + endif + if (Use_Mutrack) then + Use_Mutrack = .false. + write(*,*) '''createFoilFile'' = .true. -> set ''Use_Mutrack'' to ''.false.''' + flag_message = .true. + endif + if (Fo_triggered) then + Fo_triggered = .false. + write(*,*) '''createFoilFile'' = .true. -> set ''Fo_triggered'' to ''.false.''' + flag_message = .true. + endif + upToTDFoilOnly = .true. + generate_FE = .false. + M2_triggered = .false. + xM2_triggered = .false. + NTP_s1xM2 = .false. + NTP_times = .false. + NTP_FoM2Only = .false. + NTP_charge = .false. + NTP_Folie = .false. + elseif (.NOT.TriggerInBeam) then + Fo_triggered = .false. + upToTDFoilOnly = .false. + NTP_FoM2Only = .false. + smearS1Fo = .false. + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Aufbereiten von 'geo_filename': + + call str$upCase(geo_filename,geo_filename) + if (geo_filename.EQ.'2') then + geo_filename = 'GEO_KAMMER_RUN2' + elseif (geo_filename.EQ.'3'.OR.geo_filename.EQ.'4') then + geo_filename = 'GEO_KAMMER_RUN3-4' + elseif (geo_filename.EQ.'6'.OR.geo_filename.EQ.'7'.OR. + + geo_filename.EQ.'8') then + geo_filename = 'GEO_KAMMER_RUN6-8' + elseif (geo_filename.EQ.'8L' .OR. geo_filename.EQ.'7L') then + geo_filename = 'GEO_KAMMER_RUN7_LONG' + elseif (geo_filename.EQ.'9') then + geo_filename = 'GEO_KAMMER_RUN9' + elseif (geo_filename.EQ.'9N') then + geo_filename = 'GEO_KAMMER_RUN9_NEW' + elseif (geo_filename.EQ.'10') then + geo_filename = 'GEO_KAMMER_RUN10' + elseif (geo_filename.EQ.'11') then + geo_filename = 'GEO_KAMMER_RUN11' + endif + + +c gegebenfalls Abstand zwischen hinterem Triggergitter und Massegitter anpassen: + + if (index(geo_fileName,'_RUN9' ).NE.0 .OR. + + index(geo_fileName,'_RUN10').NE.0) then + dx5 = 15 ! Default: 8 mm + endif + + +c 'GridInFrontOfFoil' gab es bis jetzt nur in Run 9: + + if (gridInFrontOfFoil .AND. index(geo_fileName,'_RUN9').EQ.0) then + write(*,*) + write(*,*) 'Ein Gitter vor der Triggerfolie gab es bis jetzt nur in Run9' + write(*,*) ' => setze ''gridInFrontOfFoil'' auf .false.!' + write(*,*) + gridInFrontOfFoil = .false. + flag_message = .true. + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der Schleifenparameter in das Feld 'par': + + do k = 1, 3 + + par(k,UTgt) = U_Tgt_ (k) + par(k,UGua) = U_Gua_ (k) + par(k,UG1) = U_G1_ (k) + par(k,UL1) = U_L1_ (k) + par(k,USp) = U_Sp_ (k) + par(k,UL2) = U_L2_ (k) + par(k,UL3) = U_L3_ (k) + + par(k,UFolie) = U_Folie_ (k) + par(k,UVorne) = U_Vorne_ (k) + par(k,UHinten) = U_Hinten_(k) + par(k,UMCP3) = U_MCP3_ (k) + + par(k,UMCP2) = U_MCP2_ (k) + + par(k,BHelm) = B_Helm_ (k) + par(k,BTD) = B_TD_ (k) + + par(k,alfTgt) = alfaTgt_ (k) + par(k,alfSp) = alfaSp_ (k) + par(k,alfTD) = alfaTD_ (k) + + par(k,mass) = Masse_ (k) + par(k,charge) = Ladung_ (k) + par(k,ener) = E0_ (k) + par(k,yPos) = y0_ (k) + par(k,zPos) = z0_ (k) + par(k,thetAng) = theta0_ (k) + par(k,phiAng) = phi0_ (k) + + par(k,Thickn) = Thickness_(k) + par(k,Eloss) = mean_Eloss_(k) + + par(k,DeltaL1) = DeltaL1_(k) + par(k,DeltaL2) = DeltaL2_(k) + + enddo + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Einlesen der zu verwendenden Kammergeometrie (falls Use_MUTRACK oder Use_ACCEL +c gesetzt ist wird weiter unten ein Teil der Kammergeometrie nochmal ueber- +c schrieben): + + open(lunREAD,file=geo_fileName, + + defaultfile=geoDIR//':.INPUT',status='OLD',readonly) + read(lunREAD,nml=kammer_geo) + rewind (lunREAD) + call READ_TRIGGER_GEO ! Drahtdurchmesser und -abstaende einlesen + close(lunREAD) + if (TriggerInBeam .AND. mappenName_Fo.EQ.' ') then + write(*,*) + write(*,*) ' Im Geo_file ' + write(*,*) + write(*,*) ' '//geo_fileName + write(*,*) + write(*,*) ' ist kein Name fuer die Potentialmappe der Folie angegeben!' + write(*,*) ' => bei dieser Kammergeometrie ist offensichtlich kein Triggerdetektor vorgesehen.' + write(*,*) ' => ''TriggerInBeam'' auf ''.false.'' gesetzt' + TriggerInBeam = .false. + if (createFoilFile) then + createFoilFile = .false. + write(*,*) ' -> set ''createFoilFile'' to ''.false.''' + endif + flag_message = .true. + endif + + +c falls .NOT.use_MUTRACK: +c pruefe an dieser Stelle, ob mit die Kammergeometrie die Linse 2 beinhaltet. +c Falls ja, lege den Winkel des Triggerdetektors auf Null fest. Ansonsten +c setze die Spannung an Linse 2 auf konstant Null: +c (im Falle von 'use_MUTRACK' wurden diese Aktionen gegebenenfalls ja schon beim +c Erstellen des 'foilFiles' durchgefuehrt) + + if (.NOT.use_MUTRACK) then + if (mappenName_L2andFo.NE.' ') then + ! => Linse 2 montiert + lense2 = .true. + ! => gemeinsame Mappe fuer Linse 2 und TD-Folie + ! => TD-Winkel kann nicht variiert werden: + if (alfaTD_(1).NE.0 .OR. (alfaTD_(2).NE.0 .AND. alfaTD_(2).NE.+1.e10)) then + write(*,*) + write(*,*) ' with lense 2 mounted the angle of the trigger detector is not variable' + write(*,*) ' -> set alfaTD_ == 0.' + write(*,*) + par(1,alfTD) = 0. + par(2,alfTD) = 0. + flag_message = .true. + endif + else + par(1,UL2) = 0. + par(2,UL2) = 0. + endif + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der INFO-Files der Feldmappen (und Setzen einiger Variabler mit +c mappenspezifischen Positionsangaben): + + call read_INFOs + + if (.NOT.(upToTDFoilOnly .OR. createFoilFile) .AND. + + radius_MCP2.LT.radius_MCP2active) then + write(*,*) + write(*,*) 'radius of MCP2 = ',radius_MCP2 + write(*,*) 'radius of the active area of MCP2 = ',radius_MCP2active + write(*,*) 'radius_MCP2active has to be .LE. radiusMCP2!!' + write(*,*) + call exit + endif + + if (lense2) then + ! pruefen, ob die Angaben des Geometriefiles mit den Vorgaben + ! der 'L2andFo'-Mappe kompatibel ist (Mappenende muss mit Folien- + ! ebene zusammenfallen): + ! (bei 'use_MUTRACK' ist 'lense2' gegebenenfalls an dieser Stelle + ! noch nicht gesetzt!) + ! ?: Auch noch pruefen, ob Mappenbeginn mit Spiegelmappe ueberlappt + if (xLeaveMap_L2andFo .NE. xTD-d_Folie_Achse) then + write(*,*) 'Angaben des Geometriefiles sind nicht kompatibel mit den Vorgaben aus' + write(*,*) mappenName_L2andFo + write(*,*) ' Mappenende bei ',xLeaveMap_L2andFo + write(*,*) ' Ebene der Triggerfolie bei ',xTD-d_Folie_Achse + call exit + endif + endif + + ! Umrechenen der Blendenposition von 'relativ zum MCP2' in + ! absoluten x-Wert: + xBlende = xMCP2-xBlende + if (xBlende.LT.xEnterMap_M2.OR.xBlende.GT.xMCP2) then + if (xBlende.GT.0..AND.xBlende.LE.xMCP2) then + write(*,*) 'Beginn der MCP2-Mappe: x = ',xEnterMap_M2 + write(*,*) 'Position der Blende: x = ',xBlende + write(*,*) '=> Blende liegt vor der Mappe => wird ignoriert!' + flag_message = .true. + endif + xBlende=-1. + endif + +c=============================================================================== +c fuer 'fromScratch','Use_ACCEL' und 'Use_MUTRACK' separate Abschnitte: +c=============================================================================== + + if (Use_ACCEL.OR.Use_MUTRACK) fromScratch = .false. + + if (fromScratch) then ! 1: if ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +c Umrechnen der eingelesenen xGrid1- und xGrid2-Werte von Angaben relativ zur +c Moderatorfolie in Angaben relativ zur Kryoachse: + + xGrid1 = xGrid1 + xTarget + xGrid2 = xGrid2 + xTarget + +c Falls die Anzahl zufallsverteilter Starts <= 0 sein sollte, vergiss die +c Zufallsstarts: + + if (randomStarts.LE.0) then + random_energy = 0 + random_position = 0 + random_winkel = 0 + endif + + + elseif (Use_ACCEL) then ! 1: elseif ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +c Spezielle Anweisungen fuer den Fall, dass ACCEL-Simulationen der Trajektorien +c im Beschleuniger als Ausgangspunkt fuer die MUTRACK-Simulationen verwendet +c werden sollen: + +c - Oeffnen des INFO-Files: + + open(lunREAD,file=fileName_ACCEL,defaultfile=ACCEL_Dir//':.INFO', + + status='OLD',readonly) + +c - Festlegen von AccelVersionIndx: + + read(lunREAD,nml=acVersion,iostat=iostat) + rewind(lunREAD) + if (iostat.NE.0) then + accelVersion = '1.0.?' + AccelVersionIndx = 0 + else + length = len(accelVersion) + pos1 = index(accelVersion,'.') + pos2 = pos1 + index(accelVersion(pos1+1:length),'.') + read(accelVersion( 1:pos1-1),*) Version1 + read(accelVersion(pos1+1:pos2-1),*) Version2 + read(accelVersion(pos2+1:length),*) Version3 + + k = 10000*Version1 + 100*Version2 + Version3 + if (k.LT.010101) then + AccelVersionIndx = 0 + elseif (k.LT.10201) then + ! Versionen ohne Magnetfelder + AccelVersionIndx = 1 + else + AccelVersionIndx = 2 + endif + endif + + if (AccelVersionIndx.EQ.0) then + write(*,*) + write(*,*) fileName_ACCEL + write(*,*) + write(*,*) 'Die Simulation wurde mit ACCEL-Version < 1.1.1 erstellt.' + write(*,*) 'Diese ACCEL-Versionen mit unformatiertem Ausgabefile' + write(*,*) 'anstelle von NTupeln werden seit MUTRACK-Version 1.5.1' + write(*,*) 'nicht mehr unterstuetzt!' + write(*,*) + call exit + endif + +c - Einlesen der Parametereinstellungen waehrend ACCEL: +c Um die allgemeinen Parametereinstellungen zu haben, mit denen die ACCEL- +c simulationen durchgefuehrt wurden, wird das Namelist /parameter_liste/ +c eingelesen. Dieses enthaelt aber bei den .INFO files im Gegensatz zu der +c gleichnamigen Namelist der Eingabefiles fuer MUTRACK und ACCEL nicht die +c Angaben fuer die 'Schleifenparameter', welche statt dessen in einem eigenen +c Namelist 'loop_params' abgelegt sind. Dieses wird hier nur eingelesen, +c falls fuer die Schleifenparameter (zumindest teilweise) die Einstellungen +c waehrend der ACCEL-Simulation uebernommen werden sollen (-> logical +c 'previousSettings'). Ansonsten wird die Information aus /loop_params/ +c in der Subroutine 'getPreviousSettings' gelesen und ausgewertet. Entsprechendes +c gilt fuer 'artList'. + + read(lunREAD,nml=parameter_liste) + rewind(lunREAD) + ! fuer Kompatibilitaet mit frueheren Versionen, bei denen statt + ! der Extension '_prevSim' noch die Extension '_AH' verwendet wurde: + if (useDecay_AH) useDecay_prevSim = .true. + if (artList_AH.NE.' ') artlist_prevSim = artList_AH + if (randomStarts_AH.NE.-1E8) randomStarts_prevSim = randomStarts_AH + + if (previousSettings) then + +c -- Resetten der Parameterliste: + + do k = 1, 3 + U_Tgt_(k) = defVal(k) + U_Gua_(k) = defVal(k) + U_G1_(k) = defVal(k) + B_Helm_(k) = defVal(k) + B_TD_(k) = defVal(k) + Masse_(k) = defVal(k) + Ladung_(k) = defVal(k) + E0_(k) = defVal(k) + y0_(k) = defVal(k) + z0_(k) = defVal(k) + theta0_(k) = defVal(k) + phi0_(k) = defVal(k) + enddo + U_Gua_(1) = -1.e10 + Masse_(1) = 105659. + Ladung_(1) = 1. + +c -- Einlesen der Schleifensettings waehrend ACCEL: + + read(lunREAD,nml=loop_params) + rewind (lunREAD) + +c -- Uebernehmen der geforderten Parameter: + + if (artList_prevSim.NE.' ') then + ow_masse = ow_artList + ow_Ladung = ow_artList + else + ow_artList = .false. + endif + if (.NOT.ow_artList) artList = artList_prevSim + do k = 1, 3 + if (.NOT.ow_U_Tgt) par(k,UTgt) = U_Tgt_ (k) + if (.NOT.ow_U_Gua) par(k,UGua) = U_Gua_ (k) + if (.NOT.ow_U_G1) par(k,UG1) = U_G1_ (k) + if (.NOT.ow_B_Helm) par(k,BHelm) = B_Helm_ (k) + if (.NOT.ow_B_TD) par(k,BTD) = B_TD_ (k) + if (.NOT.ow_Masse) par(k,mass) = Masse_ (k) + if (.NOT.ow_Ladung) par(k,charge) = Ladung_ (k) + if (.NOT.ow_E0) par(k,ener) = E0_ (k) + if (.NOT.ow_y0) par(k,yPos) = y0_ (k) + if (.NOT.ow_z0) par(k,zPos) = z0_ (k) + if (.NOT.ow_theta0) par(k,thetAng) = theta0_ (k) + if (.NOT.ow_phi0) par(k,phiAng) = phi0_ (k) + enddo + endif + +c -- Auswerten der Vorgabe: + + call examine_artList + call getPreviousSettings + rewind (lunREAD) + +c - Einlesen der Targetgeometrie aus dem INFO-file: + + call read_ACCEL_geometry + rLNShield = rLNShield*scaleFactor + +c - gegebenenfalls E0-Intervalle einlesen: + + if (E0InterFromFile) then + rewind (lunREAD) + zeile = ' ' + do while (index(zeile,'BOUNDARIES OF E0-INTERVALLS').EQ.0) + read (lunREAD,'(A)') zeile + call str$upcase(zeile,zeile) + enddo + do k = 1, nint(E0_(2))+1 + read (lunREAD,*) E0Low(k) + enddo + do k = 1, nint(E0_(2)) + write(*,'(x,A,I4,A,F6.3,A,F6.3,A)') 'E0-intervall',k,': [',E0Low(k),',',E0Low(k+1),']' + enddo + endif + + close(lunREAD) + +c - Anzahl der Zufallsstarts setzen: + + if (randomStarts.LT.0 .OR. randomStarts.GT.randomStarts_prevSim) then + randomStarts = randomStarts_prevSim + endif + + + else ! => Use_MUTRACK ! 1: else ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +c Spezielle Anweisungen fuer den Fall, dass fruehere MUTRACK-Simulationen bis +c zur Triggerfolie als Ausgangspunkt fuer weitere Simulationen eingelesen werden +c sollen: +c (wurde die fruehere MUTRACK-Simulation mit 'Use_ACCEL' erstellt, so wird auch +c jetzt beim Einlesen des INFO-files 'Use_ACCEL' wieder auf '.true.' gesetzt. +c Dies geschieht, um beim Erstellen des LOG-files die entsprechenden Informa- +c tionen zur Verfuegung zu haben. Nach dem Erstellen des LOG-Files wird +c 'Use_ACCEL' dann wieder negiert). + +c - Oeffnen des INFO-Files: + + open(lunREAD,file=fileName_MUTRACK,defaultfile=outDir//':.INFO', + + status='OLD',readonly) + +c - Festlegen von MutrackVersionIndx: + + read(lunREAD,nml=muVersion) + rewind(lunREAD) + length = len(mutrackVersion) + pos1 = index(mutrackVersion,'.') + pos2 = pos1 + index(mutrackVersion(pos1+1:length),'.') + read(MutrackVersion( 1:pos1-1),*) Version1 + read(MutrackVersion(pos1+1:pos2-1),*) Version2 + read(MutrackVersion(pos2+1:length),*) Version3 + k = 10000*Version1 + 100*Version2 + Version3 + if (k.LT.010501) then + ! Versionen ohne Linse 2 und ohne Magnetfelder + MutrackVersionIndx = 1 + else + MutrackVersionIndx = 2 + endif + +c - Einlesen der zugehoerigen Kammer-Geometrie aus dem INFO-file: + + mappenName_L2andFo = ' ' + read(lunRead,nml=kammer_geo) + rewind (lunREAD) + if (mappenName_L2andFo.NE.' ') then + ! => Linse 2 montiert + lense2 = .true. + ! => gemeinsame Mappe fuer Linse 2 und TD-Folie + ! => TD-Winkel kann nicht variiert werden: + if (ow_alfaTD .AND. + + (alfaTD_(1).NE.0 .OR. (alfaTD_(2).NE.0 .AND. alfaTD_(2).NE.+1.e10))) then + write(*,*) + write(*,*) ' with lense 2 mounted the angle of the trigger detector is not variable' + write(*,*) ' -> set alfaTD_ == 0.' + write(*,*) + par(alfTD,1) = 0. + par(alfTD,2) = 0. + flag_message = .true. + endif + ! Geometriedaten aus INFO-file der Mappe einlesen, um sie + ! gegebenenfalls fuer Ausgabe parat zu haben: + if (write_geo) CALL READ_INFO_L2andFo + else + par(1,UL2) = 0. + par(2,UL2) = 0. + endif + +c - Einlesen der Parametereinstellungen waehrend Erstellung des 'foilFiles' +c (bis auf die Schleifenparameter. Siehe Bemerkung zu entsprechendem Abschnitt +c bei Use_ACCEL): + + read(lunREAD,nml=parameter_liste) + rewind(lunREAD) + ! fuer Kompatibilitaet mit frueheren Versionen, bei denen statt + ! der Extension '_prevSim' noch die Extension '_AH' verwendet wurde: + if (useDecay_AH) useDecay_prevSim = .true. + if (artList_AH.NE.' ') artlist_prevSim = artList_AH + if (randomStarts_AH.NE.-1E8) randomStarts_prevSim = randomStarts_AH + + if (previousSettings) then + +c -- Resetten der Parameterliste: + + do k = 1, 3 + U_Tgt_(k) = defVal(k) + U_Gua_(k) = defVal(k) + U_G1_(k) = defVal(k) + U_L1_(k) = defVal(k) + U_Sp_(k) = defVal(k) + U_L2_(k) = defVal(k) + U_Folie_(k) = defVal(k) + B_Helm_(k) = defVal(k) + B_TD_(k) = defVal(k) + alfaTgt_(k) = defVal(k) + alfaSp_(k) = defVal(k) + alfaTD_(k) = defVal(k) + Masse_(k) = defVal(k) + Ladung_(k) = defVal(k) + E0_(k) = defVal(k) + y0_(k) = defVal(k) + z0_(k) = defVal(k) + theta0_(k) = defVal(k) + phi0_(k) = defVal(k) + deltaL1_(k) = defVal(k) + enddo + U_Gua_(1) = -1.e10 + alfaSp_(1) = 45. + Masse_(1) = 105659. + Ladung_(1) = 1. + +c -- Einlesen der Schleifensettings waehrend der Erstellung des 'foilFiles': + + read(lunREAD,nml=loop_params) + rewind (lunREAD) + + ! fuer Kompatibilitaet mit aelteren foilFile-Versionen: + if (U_KL_(1).NE.-1.e10) then + do k = 1, 3 + U_L1_(k) = U_KL_(k) + enddo + endif + +c -- Uebernehmen der geforderten Parameter: + + if (artList_prevSim.NE.' ') then + ow_masse = ow_artList + ow_Ladung = ow_artList + else + ow_artList = .false. + endif + if (.NOT.ow_artList) artList = artList_prevSim + do k = 1, 3 + if (.NOT.ow_U_Tgt) par(k,UTgt) = U_Tgt_ (k) + if (.NOT.ow_U_Gua) par(k,UGua) = U_Gua_ (k) + if (.NOT.ow_U_G1) par(k,UG1) = U_G1_ (k) + if (.NOT.ow_U_L1) par(k,UL1) = U_L1_ (k) + if (.NOT.ow_U_Sp) par(k,USp) = U_Sp_ (k) + if (.NOT.ow_U_L2) par(k,UL2) = U_L2_ (k) + if (.NOT.ow_U_Folie) par(k,UFolie) = U_Folie_ (k) + if (.NOT.ow_B_Helm) par(k,BHelm) = B_Helm_ (k) + if (.NOT.ow_B_TD) par(k,BTD) = B_TD_ (k) + if (.NOT.ow_alfaTgt) par(k,alfTgt) = alfaTgt_ (k) + if (.NOT.ow_alfaSp ) par(k,alfSp) = alfaSp_ (k) + if (.NOT.ow_alfaTD ) par(k,alfTD) = alfaTD_ (k) + if (.NOT.ow_Masse) par(k,mass) = Masse_ (k) + if (.NOT.ow_Ladung) par(k,charge) = Ladung_ (k) + if (.NOT.ow_E0) par(k,ener) = E0_ (k) + if (.NOT.ow_y0) par(k,yPos) = y0_ (k) + if (.NOT.ow_z0) par(k,zPos) = z0_ (k) + if (.NOT.ow_theta0) par(k,thetAng) = theta0_ (k) + if (.NOT.ow_phi0) par(k,phiAng) = phi0_ (k) + if (.NOT.ow_deltaL1) par(k,deltaL1) = deltaL1_ (k) + enddo + endif + +c -- Auswerten der Vorgabe: + + call examine_artList + call getPreviousSettings ! liesst auch noch von 'lunREAD' + +c - gegebenenfalls E0-Intervalle einlesen: + + if (E0InterFromFile) then + rewind (lunREAD) + zeile = ' ' + do while (index(zeile,'BOUNDARIES OF E0-INTERVALLS').EQ.0) + read (lunREAD,'(A)') zeile + call str$upcase(zeile,zeile) + enddo + do k = 1, nint(E0_(2))+1 + read (lunREAD,*) E0Low(k) + enddo + do k = 1, nint(E0_(2)) + write(*,'(x,A,I4,A,F6.3,A,F6.3,A)') 'E0-intervall',k,': [',E0Low(k),',',E0Low(k+1),']' + enddo + endif + + close(lunREAD) + +c - damit, falls das 'Foilfile' selbst auf einer ACCEL-Simulation beruht, +c die zugehoerige Targetgeometrie aus dem ACCEL-INFO-File gelesen wird +c (use_ACCEL wird im Hauptprogramm dann wieder resettet): + + if (previousSimulation.EQ.1) Use_ACCEL=.true. + +c - Anzahl der Zufallsstarts setzen: + + if (randomStarts.LT.0 .OR. randomStarts.GT.randomStarts_prevSim) then + randomStarts = randomStarts_prevSim + endif + + endif ! 1: endif ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +c=============================================================================== +c Ab hier wieder fuer 'fromScratch', 'Use_ACCEL' und 'Use_MUTRACK' gemeinsam +c=============================================================================== + +c Startgebiet und -Koordinate festlegen: + + if (StartFlaeche.EQ.-1) then + if (Kammerteil.LE.1) then + if (x0_.LE.0) then + x0_ = 0. + Startflaeche = 0 + Gebiet0 = target + elseif (x0_.LE.xGrid1) then + Gebiet0 = upToGrid1 + if (x0_.EQ.xGrid1) Startflaeche = 1 + elseif (x0_.LE.xGrid2) then + Gebiet0 = upToGrid2 + elseif (x0_.LE.rHeShield) then + Gebiet0 = upToHeShield + elseif (x0_.LE.rLNShield) then + Gebiet0 = upToLNShield + elseif (x0_.LE.xEnterMap_L1) then + Gebiet0 = upToL1Map + elseif (x0_.LE.xLeaveMap_L1) then + Gebiet0 = upToExL1 + else + Gebiet0 = upToEnSp + endif + else + if (x0_.LE.xEnterMap_L3) then + if (lense2) then + if (x0_.LE.xEnterMap_L2andFo) then + Gebiet0 = upToL2andFoMap + elseif (x0_.LE.xEndLense_L2) then + Gebiet0 = upToExL2 + elseif (x0_.LE.xLeaveMap_L2andFo) then + Gebiet0 = upToEnTD + endif + elseif (TriggerInBeam) then + Gebiet0 = upToEnTD + else + Gebiet0 = upToL3Map + endif + elseif (x0_.LE.xEnterMap_L3) then + Gebiet0 = upToL3Map + elseif (x0_.LE.xLeaveMap_L3) then + Gebiet0 = upToExL3 + elseif (x0_.LE.xEnterMap_M2) then + Gebiet0 = upToM2Map + else + Gebiet0 = upToMCP2 + endif + endif + x0(1) = x0_ + elseif (StartFlaeche.EQ.1) then + Gebiet0 = upToGrid2 + x0(1) = xGrid1 + elseif (StartFlaeche.EQ.2) then + TriggerInBeam = .true. + Gebiet0 = upToExTD + log_alpha0_KS = .true. + x0(1) = 0. + elseif (StartFlaeche.EQ.3) then + TriggerInBeam = .true. + Gebiet0 = upToExTD + x0(1) = 0. + else + Startflaeche = 0 + Gebiet0 = target + x0(1) = xtarget + endif + + if (Gebiet0.GT.upToExTD) then + if (createFoilFile.OR.generate_FE.OR.upToTDFoilOnly) then + write(*,*)' ''Gebiet0.GT.upToExTD''' + if (createFoilFile) then + createFoilFile = .false. + write(*,*) ' -> set ''createFoilFile'' to ''.false.''' + endif + if (generate_FE) then + generate_FE = .false. + write(*,*) ' -> set ''generate_FE'' to ''.false.''' + endif + if (upToTDFoilOnly) then + upToTDFoilOnly = .false. + write(*,*) ' -> set ''upToTDFoilOnly'' to ''.false.''' + endif + flag_message = .true. + endif + endif + if (Gebiet0.GT.upToLnShield) NTP_40mm = .false. + + +c Zufallsverteilung fuer Startenergie? + + if (random_energy.GE.1 .AND. random_energy.LE.2) then + random_E0 = .true. + + if (random_energy.EQ.1 .AND..NOT.(lowerE0.EQ.0..AND.upperE0.EQ.0.)) then + if (lowerE0.GT.upperE0) then + help = lowerE0 + lowerE0 = upperE0 + upperE0 = help + endif + random_E0_equal = .true. + + elseif (random_energy.EQ.2 .AND..NOT.(sigmaE0.EQ.0.)) then + random_E0_gauss = .true. + + else + random_E0 = .false. + endif + + elseif (random_energy.NE.0) then + write(*,*) + write(*,*) 'random_energy = ',random_energy,' is not defined' + write(*,*) + call exit + endif + + if (.NOT.random_E0 .AND. par(1,ener).EQ.0. .AND. par(2,ener).EQ.0.) then + do k = 1, 3 + par(k,phiAng) = 0. + par(k,ThetAng) = 0. + enddo + endif + + +c Zufallsverteilung fuer Startpositionen? + + if (random_position.GE.1 .AND. random_position. LE.4) then + random_pos = .true. + ! setze gegebenenfalls Defaultwerte ein: + if (startBreite.LT.0.) startBreite = dyTarget + if (startHoehe .LT.0.) startHoehe = dzTarget + if (startRadius.LT.0.) startRadius = 20. + sigmaPosition = abs(sigmaPosition) + + if (random_position.EQ.1 .AND. + + .NOT.(StartBreite.EQ.0 .AND. StartHoehe.EQ.0)) then + random_y0z0_equal = .true. + + elseif (random_position.EQ.2 .AND. .NOT.StartRadius.EQ.0) then + random_r0_equal = .true. + + elseif (random_position.EQ.3 .AND. .NOT.sigmaPosition.EQ.0. + + .AND. .NOT.(StartBreite.EQ.0 .AND. StartHoehe.EQ.0)) then + random_y0z0_Gauss = .true. + + elseif (random_position.EQ.4 .AND. .NOT.StartRadius.EQ.0. + + .AND. .NOT.sigmaPosition.EQ.0.) then + random_r0_Gauss = .true. + + else + random_pos = .false. + endif + elseif (random_position.NE.0) then + write(*,*) + write(*,*) 'random_position = ',random_position,' is not defined' + write(*,*) + call exit + endif + + +c Zufallsverteilung fuer Startwinkel? + + if (random_winkel.GE.1 .AND. random_winkel.LE.2) then + random_angle = .true. + if (random_winkel.EQ.1) then + random_lambert = .true. + elseif (random_winkel.EQ.2 .AND. .NOT.sigmaWinkel.EQ.0.) then + random_gauss = .true. + else + random_angle = .false. + endif + elseif (random_winkel.NE.0) then + write(*,*) + write(*,*) 'random_winkel = ',random_winkel,' is not defined' + write(*,*) + call exit + endif + + +c Durchlaufzahl fuer die 'Zufallsschleife' setzen: + + if (random_E0.OR.random_pos.OR.random_angle) then + par(2,0) = randomStarts ! (Default = 1) + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Falls der Trigger nicht im Strahlweg haengt sollen die Triggerschleifen +c nicht unnoetig durchlaufen werden. Ausserdem fallen dann auch Energieverlust +c und Aufstreuung in der Folie weg. Auch muessen keine Folienelektronen +c generiert werden: + + if (.NOT.TriggerInBeam) then + do k = 1, 3 + par(k,UFolie) = 0. + par(k,UVorne) = 0. + par(k,UHinten)= 0. + par(k,UMCP3) = 0. + par(k,alfTD) = 0. + par(k,Eloss) = 0. + par(k,Thickn) = 0. + enddo + n_E_Verlust = 0 + n_aufstreu = 0 + log_neutralize = .false. + ntp_folie = .false. + Fo_triggered = .false. + upToTDFoilOnly = .false. + generate_FE = .false. + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c wurde die Variable 'artList' nicht gesetzt, setze 'UseDecay' und +c 'log_neutralize' auf .false. (steht wegen 'log_neutralize' an dieser Stelle) + + if (fromScratch) call examine_artList + if (.NOT.artList_defined) then + if (UseDecay) then + UseDecay = .false. + write(*,1000) 'Myonen-Zerfall nur bei Verwendung von '// + + '''ArtList''','UseDecay = .false. gesetzt' + flag_message = .true. + endif + if (log_neutralize) then + log_neutralize = .false. + write(*,1000) 'Neutralisierung nur bei Verwendung von '// + + '''ArtList''','log_neutralize = .false. gesetzt' + flag_message = .true. + endif + endif + if (.NOT.UseDecay) NTP_lifeTime = .false. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c falls nur bis zur Triggerfolie gerechnet werden soll: Streiche Erstellung +c aller Tabellen, Statistiken und NTupel-Eintraege die bis dahin nicht +c gefuellt werden. Setze Spannung an L3 und MCP2 auf 0. Negiere alle Aktionen, +c die erst danach stattfaenden. ('upToTDFoilOnly' ist auch gesetzt bei +c 'createFoilFile'): + + if (upToTDFoilOnly) then + n_E_Verlust = 0 + n_Aufstreu = 0 + log_neutralize = .false. + xM2_triggered = .false. + M2_triggered = .false. + do k = 1, 3 + par(k,UL3) = 0. + par(k,UMCP2) = 0. + par(k,deltaL2) = 0. + par(k,Thickn) = 0. + par(k,Eloss) = 0. + enddo + if (.NOT.generate_FE) then + do k = 1, 3 + par(k,UVorne) = 0. + par(k,UHinten) = 0. + par(k,UMCP3) = 0. + enddo + endif + + NTP_S1xM2 = .false. + NTP_FoM2Only = .false. + NTP_Folie = .false. + NTP_charge= .false. + + SUM_S1xM2 = .false. + SUM_S1M2 = .false. + SUM_FoM2 = .false. + SUM_M3M2 = .false. + SUM_y_M2 = .false. + SUM_z_M2 = .false. + SUM_r_M2 = .false. + SUM_y_xM2 = .false. + SUM_z_xM2 = .false. + SUM_r_xM2 = .false. + + PHY_S1xM2 = .false. + PHY_S1M2 = .false. + PHY_FoM2 = .false. + PHY_M3M2 = .false. + PHY_y_M2 = .false. + PHY_z_M2 = .false. + PHY_r_M2 = .false. + PHY_y_xM2 = .false. + PHY_z_xM2 = .false. + PHY_r_xM2 = .false. + + TAB_S1xM2 = .false. + TAB_S1M2 = .false. + TAB_FoM2 = .false. + TAB_M3M2 = .false. + TAB_y_M2 = .false. + TAB_z_M2 = .false. + TAB_r_M2 = .false. + TAB_y_xM2 = .false. + TAB_z_xM2 = .false. + TAB_r_xM2 = .false. + endif + + +c falls der Triggerdetektor im Strahl haengt: nimm entsprechende Einstellungen +c fuer Energieverlust, Aufstreuung und Neutralisierung vor. Andernfalls: +c streiche alle Statistiken und Tabellen, die auf ihm beruhen. + + if (TriggerInBeam) then + !c Energie-Verlust in der Triggerfolie beruecksichtigen? + if (abs(n_E_Verlust).GE.1 .AND. abs(n_E_Verlust).LE.5) then + log_E_Verlust = .true. + + if (n_E_Verlust.LT.0) then + log_E_Verlust_defined = .true. + if (par(1,Eloss).LT.0) then + write(*,*) + write(*,*)'mittlerer E-Verlust muss positiv sein' + write(*,*) + call exit + endif + else + log_E_Verlust_ICRU = .true. + do k = 1, 3 + par(k,Eloss) = 0. + enddo + endif + + n_E_verlust = ABS(n_E_verlust) + + if (n_E_verlust.EQ.1) then + ! scharfer Energieverlust, also keine Aufstreuung + elseif (n_E_verlust.EQ.2 .AND. sigmaE.NE.0.) then + log_E_Straggling_sigma = .true. + sigmaE = abs(sigmaE) + elseif (n_E_verlust.EQ.3 .AND. .NOT.(lowerE.EQ.0.AND.upperE.EQ.0)) then + log_E_Straggling_equal = .true. + if (lowerE.GT.upperE) then + help = lowerE + lowerE = upperE + upperE = help + endif + elseif (n_E_verlust.EQ.4) then + log_E_Straggling_Lindhard = .true. + elseif (n_E_verlust.EQ.5) then + log_E_Straggling_Yang = .true. + endif + + elseif (n_E_Verlust.NE.0) then + write(*,*) + write(*,*) 'n_E_Verlust = ',n_E_Verlust,' is not defined' + write(*,*) + call exit + else ! -> n_E_Verlust = 0 + do k = 1, 3 + par(k,Eloss) = 0. + enddo + endif + + ! Falls Berechnung des mittleren Energieverlustes aus ICRU-Tabelle: + ! Falls die Teilchen nicht vom Moderator oder vom 1. Gitter starten, + ! berchne den mittleren Energieverlust fuer jedes Teilchen neu. + ! Sonst: Wenn der mittlere Energieverlust nicht aus ICRU Tabelle + ! berechnet werden soll oder alle Teilchen (einer Schleife) die + ! exakt gleiche Startenergie haben, streiche 'calculate_each': + if (log_E_Verlust_ICRU.AND.random_E0 .AND. + + (Startflaeche.NE.0 .AND. Startflaeche.NE.1)) then + calculate_each = .true. + elseif (.NOT.(log_E_Verlust_ICRU.AND.random_E0)) then + calculate_each = .false. + endif + + ! Aufstreuung in der Folie beruecksichtigen? + if (n_aufstreu.GE.1 .AND. n_aufstreu.LE.3) then + log_aufstreu = .true. + if (n_aufstreu.EQ.1) then + log_aufstreu_fixed = .true. + if (sigmaAufstreu.EQ.0.) then + log_aufstreu = .false. + elseif (sigmaAufstreu.LT.0) then + write(*,1000) '''sigmaAufstreu.LT.0''','verwende Absolutbetrag' + flag_message = .true. + sigmaAufstreu = abs(sigmaAufstreu) + endif + elseif (n_Aufstreu.EQ.2) then + log_Meyer_Gauss = .true. + elseif (n_Aufstreu.EQ.3) then + log_Meyer_F_Function = .true. + endif + elseif (n_Aufstreu.NE.0) then + write(*,*) + write(*,*) 'n_Aufstreu = ',n_Aufstreu,' is not defined' + write(*,*) + call exit + endif + + ! Neutralisierung in der Folie beruecksichtigen? + if (log_neutralize) then + do k = 1, artenMax + if ((neutral_fract(k).LT.0. .OR. neutral_fract(k).GT.100.) + + .AND. neutral_fract(k).NE.-1) then + write(*,*) + write(*,*)'die neutralen Anteile '// + + 'muessen zwischen 0 und 100 Prozent liegen!' + write(*,*)'(''-1'' wird als Code fuer automatische '// + + 'Berechnung gemaess M.Gonin akzeptiert)' + write(*,*) + call exit + endif + enddo + endif + endif + + if (.NOT.log_neutralize) ntp_charge = .false. + + +c Soll nun abgesehen von der Neutralisierung eine im Zusammenhang mit der +c Wechselwirkung der Teilchen mit der Triggerfolie auftretenden Groessen +c zufallsverteilt gewuerfelt werden, so uebernehme die Anzahl der je Schleife +c durchzufuehrender Starts, auch wenn die Startparameter selbst nicht gewuerfelt +c werden: + + if (log_E_Straggling_sigma .OR. log_E_Straggling_equal .OR. + + log_E_Straggling_Lindhard .OR. log_E_Straggling_Yang .OR. + + log_aufstreu) then + par(2,0) = randomStarts + endif + + +c Pruefe, ob die Foliendicke falls noetig tatsaechlich groesser Null ist. +c Geht die Foliendicke nicht in die Berechnungen ein, setze sie auf Null. + + if (log_E_Verlust_ICRU .OR. log_Meyer_Gauss .OR. log_Meyer_F_Function + + .OR. log_E_Straggling_Lindhard .OR. log_E_Straggling_Yang) then + if (par(1,Thickn).LE.0 .OR. par(2,Thickn).LE.0) then + write(*,*) + if (log_E_Verlust_ICRU) then + write(*,*)'Energieverlust in Triggerfolie soll aus ICRU-Tabelle berechnet werden.' + endif + if (log_Meyer_Gauss .OR. log_Meyer_F_Function) then + write(*,*)'Winkelaufstreuung in Triggerfolie soll nach Meyer-Formel berechnet werden.' + endif + if (log_E_Straggling_Lindhard) then + write(*,*)'Energieverluststreuung in C-folie soll nach Lindhard/Scharff berechnet werden.' + endif + if (log_E_Straggling_Yang) then + write(*,*)'Energieverluststreuung in C-folie soll nach Yang berechnet werden.' + endif + write(*,*)'=> Foliendicke muss positiv sein!' + write(*,*) + call exit + endif + else + do k = 1, 3 + par(k,Thickn) = 0. + enddo + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c die Parameter fuer die Schleifen setzen und die Gesamtzahl startender +c Projektile berechnen: + + call adjustLoops + + if (n_par(0).EQ.1) OneStartPerLoop = .true. + SchleifenZahl = GesamtZahl/n_par(0) + if (SchleifenZahl.EQ.1) OneLoop = .true. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Bereiche der Winkeleinstellungen checken: + + if (abs(par(1,alfTgt)).GT.15 .OR. + + abs(par(2,alfTgt)).GT.15) then + write(*,*) + write(*,*) 'Der Bereich moeglicher Targetwinkel ist auf '// + + '[-15,15] eingeschraenkt!' + write(*,*) + call exit + endif + + if (par(1,alfSP).LT.30 .OR. par(1,alfSP).GT.60 .OR. + + par(2,alfSP).LT.30 .OR. par(2,alfSP).GT.60) then + write(*,*) + write(*,*) 'Der Bereich moeglicher Spiegelwinkel ist auf '// + + '[30,60] eingeschraenkt!' + write(*,*) + call exit + endif + + if (abs(par(1,alfTD)).GT.30 .OR. + + abs(par(2,alfTD)).GT.30) then + write(*,*) + write(*,*) 'Der Bereich moeglicher Triggerwinkel ist auf '// + + '[-30,30] eingeschraenkt!' + write(*,*) + call exit + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Falls der Verdrehungswinkel des TDs Null ist und auch nicht geaendert werden +c soll sind alpha gemessen im Kammersystem und alpha gemessen im Triggersystem +c gleich. Deswegen: bleib dann gleich im Triggersystem: + + if (log_alpha0_KS) then + if (par(1,alfTD).EQ.0. .AND. n_par(alfTD).LE.1) then + log_alpha0_KS = .false. + else + write(par_text(thetAng)(7:10),'(A4)')'(KS)' + write(par_text(phiAng)(7:10),'(A4)')'(KS)' + endif + endif + +c + + if (startFlaeche.NE.0) then + alfaTgtVertically = .false. + elseif (alfaTgtVertically) then + write(par_text(alfTgt)(10:10),'(A1)') 'V' + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c falls kein NTupel erzeugt werden soll brauchen die Daten gar nicht erst fuer +c die Ntupelausgabe gespeichert zu werden. Falls umgekehrt das NTupel eh nicht +c gefuellt wird, erzeuge es erst gar nicht: + + if (.NOT.createNTP) then + NTP_S1xM2 = .false. + NTP_times = .false. + NTP_FoM2Only = .false. + NTP_charge = .false. + NTP_lifeTime = .false. + NTP_start = .false. + NTP_stop = .false. + NTP_40mm = .false. + NTP_Folie = .false. + NTP_steps = .false. + xM2_triggered= .false. + M2_triggered = .false. + Fo_triggered = .false. + elseif (.NOT. (NTP_S1xM2.OR.NTP_times.OR.NTP_FoM2Only.OR. + + NTP_charge.OR.NTP_lifeTime.OR.NTP_start.OR. + + NTP_stop.OR.NTP_40mm.OR.NTP_Folie.OR.NTP_steps)) then + createNTP = .false. + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c setze Triggerbedingungen, die bereits durch andere Triggerbedingungen +c abgedeckt sind, auf .false.: + + if (Fo_triggered) then + xM2_triggered = .false. + M2_triggered = .false. + elseif (xM2_triggered) then + M2_triggered = .false. + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Bei Debug grundsaetzlich die RunNummern von 9900 bis 9999 verwenden (TestRun). +c Bei Debug soll volles Logfile erstellt werden. Falls jedoch keine Projektil- +c DEBUG-Informationen verlangt sind, unterlasse auch die Ausgabe von FE- +c DEBUG-Informationen: + + if (DEBUG) then + if (debug_Anzahl.EQ.0) then + write(*,1000) 'debug_Anzahl = 0','es werden keine'// + + 'DEBUG-Informationen ausgegeben' + flag_message = .true. + debug = .false. + else + debug_Anzahl = min(debug_Anzahl,n_par(0)) + TestRun = .true. + if (abs(n_outWhere.LT.1)) then + n_outWhere = 1 + elseif (abs(n_outWhere).GT.2) then + n_outWhere = 2 + endif + endif + else + DEBUG_FE = .false. + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Marke 1 ====================================================================== + + if (.NOT.TriggerInBeam) then + + GridInFrontOfFoil = .false. + generate_FE = .false. ! dadurch fallen bereits einige SUM_.., + ! PHY_.. und TAB_.. weg + SUM_S1Fo = .false. + SUM_FoM2 = .false. + SUM_y_Fo = .false. + SUM_z_Fo = .false. + SUM_r_Fo = .false. + + PHY_S1Fo = .false. + PHY_FoM2 = .false. + PHY_y_Fo = .false. + PHY_z_Fo = .false. + PHY_r_Fo = .false. + + TAB_S1Fo = .false. + TAB_FoM2 = .false. + TAB_y_Fo = .false. + TAB_z_Fo = .false. + TAB_r_Fo = .false. + + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Falls keine Folienelektronen generiert werden sollen, setze alle Aktionen, +c die auf ihnen beruhen auf .false.. Falls umgekehrt weder FE-Trajektorien +c gezeichnet noch FE-Informationen verarbeitet werden sollen, generiere erst +c gar keine FE: + + if (.NOT.generate_FE) then + log_out_FE = .false. + plot_FE = .false. + debug_FE = .false. + SUM_S1M3 = .false. + SUM_M3M2 = .false. + SUM_t_FE = .false. + PHY_S1M3 = .false. + PHY_M3M2 = .false. + PHY_t_FE = .false. + TAB_S1M3 = .false. + TAB_M3M2 = .false. + TAB_t_FE = .false. + elseif (.NOT.(log_out_FE .OR. plot_FE .OR. + + SUM_S1M3 .OR. SUM_M3M2 .OR. SUM_t_FE .OR. + + PHY_S1M3 .OR. PHY_M3M2 .OR. PHY_t_FE .OR. + + TAB_S1M3 .OR. TAB_M3M2 .OR. TAB_t_FE ) ) then + generate_FE = .false. + endif + +c Marke 2 ====================================================================== +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c welche Ausgabekanaele sollen fuer das Summary durchlaufen werden? + + if (n_outWhere.NE.0) then + if (abs(n_outWhere).GT.3) then + write(*,*) + write(*,*) 'Der Bereich von n_outWhere ist auf '// + + '[-3,3] eingeschraenkt!' + write(*,*) + call exit + elseif (n_outWhere.LT.0) then + smallLogFile = .true. + n_outWhere = abs(n_outWhere) + elseif (n_outWhere.LE.2) then + LogFile = .true. ! volles Summary-File + endif + indx1 = int((n_outWhere+1)/2) ! = 1,1,2 fuer n_outWhere=1,2,3 + indx2 = int((n_outWhere+2)/2) ! = 1,2,2 fuer n_outWhere=1,2,3 + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der logicals fuer die zu erzeugenden Tabellen: +c Falls irgendwelche Tabellenfiles erzeugt werden sollen, setze 'createTabellen' +c auf .true.: + + createTabelle(Nr_S1xM2)= TAB_S1xM2 + createTabelle(Nr_S1M2) = TAB_S1M2 + createTabelle(Nr_S1Fo) = TAB_S1Fo + createTabelle(Nr_FoM2) = TAB_FoM2 + createTabelle(Nr_S1M3) = TAB_S1M3 + createTabelle(Nr_M3M2) = TAB_M3M2 + createTabelle(Nr_t_FE) = TAB_t_FE + createTabelle(Nr_y_Fo) = TAB_y_Fo + createTabelle(Nr_z_Fo) = TAB_z_Fo + createTabelle(Nr_r_Fo) = TAB_r_Fo + createTabelle(Nr_y_M2) = TAB_y_M2 + createTabelle(Nr_z_M2) = TAB_z_M2 + createTabelle(Nr_r_M2) = TAB_r_M2 + createTabelle(Nr_y_xM2) = TAB_y_xM2 + createTabelle(Nr_z_xM2) = TAB_z_xM2 + createTabelle(Nr_r_xM2) = TAB_r_xM2 + do k = 1, Stat_Anzahl + if (createTabelle(k)) createTabellen = .true. + enddo + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der logicals fuer die im Logfile auszugebenden Statistiken. +c Falls im Summary irgendwelche Statistiken ausgegeben werden sollen, setze +c 'statsInSummary' auf .true.: + + statInSummary(Nr_S1xM2)= SUM_S1xM2 + statInSummary(Nr_S1M2) = SUM_S1M2 + statInSummary(Nr_S1Fo) = SUM_S1Fo + statInSummary(Nr_FoM2) = SUM_FoM2 + statInSummary(Nr_S1M3) = SUM_S1M3 + statInSummary(Nr_M3M2) = SUM_M3M2 + statInSummary(Nr_t_FE) = SUM_t_FE + statInSummary(Nr_y_Fo) = SUM_y_Fo + statInSummary(Nr_z_Fo) = SUM_z_Fo + statInSummary(Nr_r_Fo) = SUM_r_Fo + statInSummary(Nr_y_M2) = SUM_y_M2 + statInSummary(Nr_z_M2) = SUM_z_M2 + statInSummary(Nr_r_M2) = SUM_r_M2 + statInSummary(Nr_y_xM2)= SUM_y_xM2 + statInSummary(Nr_z_xM2)= SUM_z_xM2 + statInSummary(Nr_r_xM2)= SUM_r_xM2 + do k = 1, stat_Anzahl + if (statInSummary(k)) statsInSummary = .true. + enddo + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der logicals fuer die im .PHYSICA file auszugebenden Statistiken +c und die statistischen Groessen: + + if (createPhysTab) then + statInPHYSICA(Nr_S1xM2)= PHY_S1xM2 + statInPHYSICA(Nr_S1M2) = PHY_S1M2 + statInPHYSICA(Nr_S1Fo) = PHY_S1Fo + statInPHYSICA(Nr_FoM2) = PHY_FoM2 + statInPHYSICA(Nr_S1M3) = PHY_S1M3 + statInPHYSICA(Nr_M3M2) = PHY_M3M2 + statInPHYSICA(Nr_t_FE) = PHY_t_FE + statInPHYSICA(Nr_y_Fo) = PHY_y_Fo + statInPHYSICA(Nr_z_Fo) = PHY_z_Fo + statInPHYSICA(Nr_r_Fo) = PHY_r_Fo + statInPHYSICA(Nr_y_M2) = PHY_y_M2 + statInPHYSICA(Nr_z_M2) = PHY_z_M2 + statInPHYSICA(Nr_r_M2) = PHY_r_M2 + statInPHYSICA(Nr_y_xM2)= PHY_y_xM2 + statInPHYSICA(Nr_z_xM2)= PHY_z_xM2 + statInPHYSICA(Nr_r_xM2)= PHY_r_xM2 + + whatInPHYSICA(1) = PHY_mean + whatInPHYSICA(2) = PHY_variance + whatInPHYSICA(3) = PHY_minimum + whatInPHYSICA(4) = PHY_maximum + whatInPHYSICA(5) = PHY_percent + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Sollte pro Schleife nur ein Teilchenstart erfolgen oder umgekehrt ausser +c der 'Zufalls-Schleife' keine anderen Schleife durchlaufen werden, setze +c 'createPhysTab' auf .false. und unterlasse die Ausgabe von Tabellenfiles: + + if ((OneStartPerLoop.OR.OneLoop) .AND. (createPhysTab.OR.createTabellen)) then + write(*,*) ' nur eine Schleife bzw. nur ein Start pro Schleife' + if (createPhysTab) then + createPhysTab = .false. + write(*,*) ' -> set ''createPhysTab'' to ''.false.''' + flag_message = .true. + endif + if (createTabellen) then + createTabellen = .false. + do k = 1, Stat_Anzahl + createTabelle(k) = .false. + enddo + write(*,*) ' -> set ''createTabellen'' to ''.false.''' + endif + flag_message = .true. + endif + + +c falls im .PHYSICA file keine Statistiken oder keine statistischen Groessen +c ausgegeben werden sollen, setze 'createPhysTab' auf .false. + + if (createPhysTab) then + flag = .false. + do k = 1, stat_Anzahl + if (statInPHYSICA(k)) flag = .true. + enddo + if (.NOT.flag) then + createPhysTab = .false. + write(*,*) ' no statistics specified for PHYSICA -> set ''createPhysTab'' to ''.false.''' + flag_message = .true. + else + flag = .false. + do k = 1, what_Anzahl + if (whatInPHYSICA(k)) flag = .true. + enddo + if (.NOT.flag) then + createPhysTab = .false. + write(*,*) ' no statistical entities specified -> set ''createPhysTab'' to ''.false.''' + flag_message = .true. + endif + endif + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c wenn keine Ausgabe des LOG-files vorgesehen ist, aber das PHYSICA-file, das +c NTP-file oder ein 'foilFile' erzeugt werden soll, dann ist zumindest die +c Minimalversion des LOG-files zu erstellen: + + if (.NOT.LogFile .AND. (createPhysTab.OR.createNTP.OR.createFoilFile)) then + smallLogFile = .true. ! Minimalversion erzeugen + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Falls weder grosses noch kleines Summary ausgegeben werden soll, und auch die +c Bildschirmausgabe unterbleibt, setze alle statInSummary auf .false.: + + if (statsInSummary .AND. .NOT.(LogFile .OR. smallLogFile) .AND. n_outWhere.LT.2) then + statsInSummary = .false. + do k = 1, stat_Anzahl + statInSummary(k) = .false. + enddo + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c pruefe, fuer welche Groessen Statistiken gefuehrt werden muessen, und setze +c das jeweilige 'statNeeded' auf .true.: + + do k = 1, Stat_Anzahl + if (createTabelle(k).OR.statInSummary(k).OR.statInPHYSICA(k)) then + statNeeded(k) = .true. + endif + enddo + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Bei batch jobs: entweder alle oder keine Postskripts erzeugen: + + if (batch_mode .AND. graphics) then + if (n_postSkript.GE.1) then + n_postSkript = 2 + graphics_Anzahl = min(graphics_Anzahl,50) + else + write(*,*) + write(*,*)'Ausgabe von Postskripts bei batch jobs nur, wenn ''GRAPHICS''=.true.' + write(*,*)'und ''n_Postskript''>0.' + write(*,*)'-> es werden keine .PS-files erstellt!' + write(*,*) + graphics = .false. + endif + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +1000 format(x,A,T36,'->',T40,A) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c falls keinerlei output erzeugt werden soll, breche Programm ab: + + if (.NOT.(createTabellen.OR.graphics.OR.LogFile.OR.smallLogFile.OR + + .n_outWhere.GT.1)) then + write(*,*) + write(*,*)' -> according to input file no output would be produced' + write(*,*) + call exit + endif + + +c Hole Zustimmung fuer abgeaenderte Parameter ein: + + if (flag_message .AND. .NOT.BATCH_MODE) then + write(*,1010) +1010 format(' ok? ( = ABBRUCH)',T36'-> ',$) + read(*,'(A)') antwort + + call str$upCase(antwort,antwort) + k = 0 +1 k = k+1 + if (antwort(k:k).eq.' ' .AND. k.LE.4) goto 1 + if (antwort(k:k).eq.'N' .OR. antwort(k:k).eq.'A' .OR. + + antwort(k:k).eq.'C' ) then + write(*,*) + call exit + endif + endif + + +c bei Verwendung von 'input_list' korrigiere noetigenfalls den Wert von +c 'testRun' (dort kann auch Ausgabefilenummer .ge. 9900 angegeben werden +c ohne dass der Run im INPUT-file als solcher markiert wurde) + + if (input_list.AND.gotFileNr) testRun = testRun_ + + +c falls kein Summary-File erstellt wird, braucht auch die 'T E S T - R U N' - +c Meldung nicht auf dem Bildschirm erscheinen: + + if (.NOT.(logFile.OR.smallLogFile)) testRun = .false. + + +c Bedingungen fuer die Ausgabe der Prozentzahl schon gerechneter Teilchen +c pruefen: + + if (.NOT.BATCH_MODE .AND. n_par(0).GE.50 .AND. n_outWhere.GE.2) then + log_percent = .true. + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c n_par der unbenutzten Schleifen auf 0 setzen (dies hat 1. zur Folge, dass +c die Ausgabe dieser unbenutzten Parameter im Logfile unterbleibt, und dass +c sie 2. auch nicht an PHYSICA weitergegeben werden): +c (der Spiegelwinkel wird dann unterdrueckt, wenn er konstant 45 degree hat, +c da hier dies die Normaleinstellung ist). + + if (random_E0) then + if (par(1,ener).EQ.0. .AND. par(2,ener).EQ.0.) then + n_par(ener) = 0 + ener_offset = .false. ! default = .true. + endif + else + if (par(1,ener).EQ.0. .AND. par(2,ener).EQ.0.) then + n_par(phiAng) = 0 + endif + endif + + if (random_pos .AND. + + par(1,yPos).EQ.0. .AND .par(2,yPos).EQ.0. .AND. + + par(1,zPos).EQ.0. .AND .par(2,zPos).EQ.0. ) then + n_par(yPos) = 0 + n_par(zPos) = 0 + pos_offset = .false. ! default = .true. + endif + if (random_angle .AND. + + par(1,thetAng).EQ.0. .AND .par(2,thetAng).EQ.0. .AND. + + par(1,phiAng).EQ.0. .AND .par(2,phiAng).EQ.0. ) then + n_par(thetAng) = 0 + n_par(phiAng) = 0 + angle_offset = .false. ! default = .true. + endif + + if (.NOT.random_angle .AND. + + par(1,thetAng).EQ.0. .AND .par(2,thetAng).EQ.0. ) then + n_par(phiAng) = 0 + endif + + if (.NOT.TriggerInBeam) then + n_par(UFolie) = 0 + n_par(UVorne) = 0 + n_par(UHinten) = 0 + n_par(UMCP3) = 0 + n_par(alfTD) = 0 + n_par(Eloss) = 0 + endif + + if (upToTDFoilOnly) then + n_par(UL3) = 0 + n_par(UMCP2) = 0 + if (.NOT.generate_FE) then + n_par(UVorne) = 0 + n_par(UHinten) = 0 + n_par(UMCP3) = 0 + endif + endif + + if (.NOT.guard) n_par(UGua) = 0 + if (artlist_defined) n_par(mass) = 0 + + if (par(1,alfTgt) .EQ.0. .AND. par(2,alfTgt) .EQ.0.) n_par(alfTgt) = 0 + if (par(1,alfSp) .EQ.45. .AND. par(2,alfSp ).EQ.45.) n_par(alfSp) = 0 + if (par(1,ThetAng).EQ.0. .AND. par(2,ThetAng).EQ.0.) n_par(ThetAng) = 0 + if (par(1,PhiAng) .EQ.0. .AND. par(2,PhiAng) .EQ.0.) n_par(PhiAng) = 0 + if (par(1,alfTD) .EQ.0. .AND. par(2,alfTD) .EQ.0.) n_par(alfTD) = 0 + if (par(1,Eloss) .EQ.0. .AND. par(2,Eloss) .EQ.0.) n_par(Eloss) = 0 + if (par(1,Thickn) .EQ.0. .AND. par(2,Thickn) .EQ.0.) n_par(Thickn) = 0 + if (par(1,BHelm) .EQ.0. .AND. par(2,BHelm) .EQ.0.) n_par(BHelm) = 0 + if (par(1,BTD) .EQ.0. .AND. par(2,BTD) .EQ.0.) n_par(BTD) = 0 + if (par(1,deltaL1).EQ.0. .AND. par(2,deltaL1).EQ.0.) n_par(deltaL1) = 0 + if (par(1,deltaL2).EQ.0. .AND. par(2,deltaL2).EQ.0.) n_par(deltaL2) = 0 + + if (mappenName_L2andFo.EQ.' ') n_par(UL2) = 0. + + +c noch ein paar Einstellungen fuer die Graphikausgabe ueberpruefen: + + if (.NOT.graphics) then + writeTraj2File = .false. + elseif (schnitt_x.LT.0) then + GRAPHICS_Anzahl = min(GRAPHICS_Anzahl,n_par(0)) + ! fuer 'schnitt_x' kein Wert vorgegeben => setze Defaultwert ein: + schnitt_x = xMCP2 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE adjustLoops +c ====================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + integer k,nn + real help, factor, step + + GesamtZahl=1 + + do k = 0 , par_Anzahl ! k=0: 'Zufalls-Schleife' + if (par(2,k).NE.1.E10) then ! wurde maxWert vorgegeben? + if (par(2,k).EQ.par(1,k).OR.par(3,k).EQ.0.) then + par(2,k) = par(1,k) + par(3,k) = 1. ! step = 0 vermeiden + else ! wurde step vorgegeben? + if (par(3,k).EQ.-1.E10) par(3,k)=par(2,k)-par(1,k) + endif + else + if (k.EQ.UGua .AND. (par(1,UGua).EQ.-1.E10 .OR. + + fromScratch ) ) then + guard = .false. ! default = .true. + par(1,UGua) = 0 + endif + par(2,k) = par(1,k) + par(3,k) = 1. + endif + + ! es kam vor, dass wegen der endlichen Genauigkeit numerischer Zahlen + ! die letzte Schleife nicht durchlaufen wurde. Deshalb wurden folgende + ! Befehlszeilen eingebaut: + + factor = 1 + step = par(3,k) + +1 do help = par(1,k), par(2,k), step + ! just count the loop index + enddo + + ! falls jetzt 'help' gerade geringfuegig 'hinter' par(2,k) liegt, + ! also aufgrund von Rundungsfehlern die letzte Schleife, die + ! eigentlich durchlaufen werden sollte nicht durchlaufen werden + ! wuerde, so reduziere schrittweise 'step', bis letzte Schleife + ! wieder akzeptiert wird: + ! (nachdem die Schleife fuer erledigt erklaert wurde ist + ! ((help-par(2,k))/step auf jeden Fall groesser Null!) + + if ((help-par(2,k))/step.LT.1.E-3) then + factor = factor - 0.00000003 ! (smallest number that should + ! work) + step = par(3,k) * factor +C WRITE(*,*) 'HELP, FACTOR, STEP = ',HELP,FACTOR, STEP + goto 1 + endif + par(3,k) = step +C WRITE(*,*) 'FINAL: HELP, FACTOR, STEP = ',HELP,FACTOR, STEP + + n_par(k) = int((par(2,k)-par(1,k)+par(3,k))/par(3,k) +.5) ! so werden laut + if (n_par(k).LE.0) n_par(k)=1 ! library die Anzahlen der Durchlaeufe berechnet + +c da es hier immer noch Schwierigkeiten gab (oder vielleicht noch gibt?) hier +c noch eine zusaetzliche Kontrolle: Bestimme mittels Probedurchlauf die Anzahl +c der wirklich durchlaufenen Schleifen und vergleiche mit erwartetem Wert. +c Falls hier immer noch Abweichungen bestehen, breche mit Fehlermeldung ab: + + nn = 0 + do help = par(1,k), par(2,k), par(3,k) + ! just count the loops + nn = nn + 1 + enddo + if (n_par(k).NE.nn) then + write(*,*) 'SUBROUTINE ''adjustLoops'' in ''SUB_INPUT.FOR'':' + write(*,*) 'A L A R M: n_par(k).NE.nn' + write(*,*) ' n_par(k) = ',n_par(k) + write(*,*) ' nn = ',nn + write(*,*) par_Text(k) + call exit + endif + +99 GesamtZahl = GesamtZahl * n_par(k) + + +c setze Parameter, deren Variation sinnlos waere auf Null: + + if (k.EQ.ener .AND. .NOT.random_E0 .AND. + + n_par(ener).LE.1 .AND. par(1,ener).EQ.0. ) then + par(1,thetang) = 0. + par(2,thetang) = 0. + par(1,phiAng) = 0. + par(2,phiAng) = 0. + random_angle = .false. + random_lambert = .false. + random_gauss = .false. + + elseif (k.EQ.thetAng .AND. + + n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. ) then + par(1,phiAng) = 0. + par(2,phiAng) = 0. + + endif + + if (par(1,k).EQ.-1.e10) then + par(1,k) = 0. + par(2,k) = 0. + par(3,k) = 1. + n_par(k) = 0 + endif + + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_ACCEL_GEOMETRY +c ============================== + + IMPLICIT NONE + +c Diese Subroutine liesst bei Verwendung von ACCEL-Simulationen des realen +c Beschleunigers die den Daten zugrundeliegende Beschleunigergeometrie ein. + +c Dieser Quelltext steht in einer einenen Subroutine, um Verwirrungen um +c die Speicherbezeichnungen bei MUTRACK und ACCEL im Vorfeld zu vermeiden. + + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + +c------------------------------------------------------------------------------- + + namelist /geometry/ + + scaleFactor, + + xFoil, + + xEnd_TgtHolder,Dy_Foil,Dz_Foil,Dy_TgtHolder,Dz_TgtHolder, + + outerDy_TgtHolder,outerDz_TgtHolder, + + innerDy1_TgtHolder,innerDz1_TgtHolder,innerDy2_TgtHolder,innerDz2_TgtHolder, + + xStart_Guardring,xEnd_Guardring,innerDy_Guardring,outerDy_Guardring, + + innerDz_Guardring,outerDz_Guardring, + + xPosition_Grid1,distance_wires1,dWires1,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,y_Pos_lastWire2, + + xStart_Gridframe2,xEnd_Gridframe2,innerDy_Gridframe2,outerDy_Gridframe2, + + innerDz_Gridframe2,outerDz_Gridframe2, + + rHeShield + + +c Die Groessen, die in der /geometry/-namelist von 'ACCEL' verwendet werden: + +c - moderator: + real xFoil,Dy_Foil,Dz_Foil,xEnd_TgtHolder + real innerDy1_TgtHolder,innerDz1_TgtHolder + real innerDy2_TgtHolder,innerDz2_TgtHolder + real outerDy_TgtHolder,outerDz_TgtHolder + +c nur um Infofiles von ACCEL-Versionen vor 1.2.1 einlesen zu koennen +c (wurden ab Version 1.2.1 ersetzt durch outerDy_TgtHolder, outerDz_TgtHolder): + + real Dy_TgtHolder, Dz_TgtHolder + + +c - guardring: + real xStart_Guardring,xEnd_Guardring,innerDy_Guardring,outerDy_Guardring, + + innerDz_Guardring,outerDz_Guardring + +c - first grid: + real xPosition_Grid1,distance_Wires1,dWires1,y_Pos_lastWire1, + + xStart_Gridframe1,xEnd_Gridframe1,innerDy_Gridframe1, + + outerDy_Gridframe1,innerDz_Gridframe1,outerDz_Gridframe1,xStart_Balken, + + xEnd_Balken,Dy_Balken,innerDz_Balken,outerDz_Balken + +c - second grid: + real xPosition_Grid2,distance_Wires2,dWires2,y_Pos_lastWire2, + + xStart_Gridframe2,xEnd_Gridframe2,innerDy_Gridframe2, + + outerDy_Gridframe2,innerDz_Gridframe2,outerDz_Gridframe2 + +c - He-shield: + ! real rHeShield ! schon in COM_KAMMER.INC enthalten + +c------------------------------------------------------------------------------- + + +c Einlesen der Target-Geometrie aus dem ACCEL-INFO-file: + + read(lunREAD,nml=geometry) + rewind(lunREAD) + + if (outerDy_TgtHolder.EQ.-1.E10) outerDy_TgtHolder = Dy_TgtHolder + if (outerDz_TgtHolder.EQ.-1.E10) outerDz_TgtHolder = Dz_TgtHolder + if (innerDy1_TgtHolder.EQ.-1.E10) innerDy1_TgtHolder = Dy_Foil + if (innerDz1_TgtHolder.EQ.-1.E10) innerDz1_TgtHolder = Dz_Foil + if (innerDy2_TgtHolder.EQ.-1.E10) innerDy2_TgtHolder = Dy_Foil + if (innerDz2_TgtHolder.EQ.-1.E10) innerDz2_TgtHolder = Dz_Foil + + +c gegebenenfalls Beschleunigergeometrie skalieren: +c (eigentlich nicht fuer alle noetig, da nicht alle von Mutrack verwendet werden. +c Aber besser fuer zu viele als fuer zu wenige...) + + if (scaleFactor.NE.1) then + xFoil = scaleFactor * xFoil + xEnd_TgtHolder = scaleFactor * xEnd_TgtHolder + Dy_Foil = scaleFactor * Dy_Foil + innerDy1_TgtHolder = scaleFactor * innerDy1_TgtHolder + innerDz1_TgtHolder = scaleFactor * innerDz1_TgtHolder + innerDy2_TgtHolder = scaleFactor * innerDy2_TgtHolder + innerDz2_TgtHolder = scaleFactor * innerDz2_TgtHolder + outerDy_TgtHolder = scaleFactor * outerDy_TgtHolder + outerDz_TgtHolder = scaleFactor * outerDz_TgtHolder + Dz_Foil = scaleFactor * Dz_Foil + xStart_Guardring = scaleFactor * xStart_Guardring + xEnd_Guardring = scaleFactor * xEnd_Guardring + innerDy_Guardring = scaleFactor * innerDy_Guardring + outerDy_Guardring = scaleFactor * outerDy_Guardring + innerDz_Guardring = scaleFactor * innerDz_Guardring + outerDz_Guardring = scaleFactor * outerDz_Guardring + xPosition_Grid1 = scaleFactor * xPosition_Grid1 + distance_wires1 = scaleFactor * distance_wires1 + dWires1 = scaleFactor * dWires1 + y_Pos_lastWire1 = scaleFactor * y_Pos_lastWire1 + xStart_Balken = scaleFactor * xStart_Balken + xEnd_Balken = scaleFactor * xEnd_Balken + Dy_Balken = scaleFactor * Dy_Balken + innerDz_Balken = scaleFactor * innerDz_Balken + outerDz_Balken = scaleFactor * outerDz_Balken + xStart_Gridframe1 = scaleFactor * xStart_Gridframe1 + xEnd_Gridframe1 = scaleFactor * xEnd_Gridframe1 + innerDy_Gridframe1 = scaleFactor * innerDy_Gridframe1 + outerDy_Gridframe1 = scaleFactor * outerDy_Gridframe1 + innerDz_Gridframe1 = scaleFactor * innerDz_Gridframe1 + outerDz_Gridframe1 = scaleFactor * outerDz_Gridframe1 + xPosition_Grid2 = scaleFactor * xPosition_Grid2 + distance_wires2 = scaleFactor * distance_wires2 + dWires2 = scaleFactor * dWires2 + y_Pos_lastWire2 = scaleFactor * y_Pos_lastWire2 + xStart_Gridframe2 = scaleFactor * xStart_Gridframe2 + xEnd_Gridframe2 = scaleFactor * xEnd_Gridframe2 + innerDy_Gridframe2 = scaleFactor * innerDy_Gridframe2 + outerDy_Gridframe2 = scaleFactor * outerDy_Gridframe2 + innerDz_Gridframe2 = scaleFactor * innerDz_Gridframe2 + outerDz_Gridframe2 = scaleFactor * outerDz_Gridframe2 + rHeShield = scaleFactor * rHeShield + endif + + +c Uebertragen der Geometriegroessen in die von 'MUTRACK' verwendeten Speicher: +c (x-Positionen sind bei 'ACCEL'-Outputs bereits relativ zur Kryoachse; +c dy- und dz-Ausdehnungen sind bei 'ACCEL' in 50% des totalen Wertes angegeben) + + xTarget = xFoil + dyTarget = 2 * Dy_Foil + dzTarget = 2 * Dz_Foil + + xGrid1 = xPosition_Grid1 + dyGrid1 = 2 * innerDy_Gridframe1 + dzGrid1 = 2 * innerDz_Gridframe1 + dWires_G1 = dWires1 + dist_Wires_G1 = distance_Wires1 + + xGrid2 = xPosition_Grid2 + dyGrid2 = 2 * innerDy_Gridframe2 + dzGrid2 = 2 * innerDz_Gridframe2 + dWires_G2 = dWires2 + dist_Wires_G2 = distance_Wires2 + + ! Der Radius des He-Schildes ist sowohl bei 'ACCEL' als auch bei + ! 'MUTRACK' mit 'rHeShield' bezeichnet, muss also nicht explizit + ! uebertragen werden. + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE getPreviousSettings +c ============================== + +c Diese Subroutine liest die 'Schleifenparameter', mit denen gegebenenfalls +c das 'ACCEL-file' bzw. das 'FoilFile' erstellt worden ist, in ein separates +c Feld 'par_prevSim' ein. Dies wird benoetigt, um fuer die jeweiligen Settings +c der 'Schleifenparameter' im aktuellen MUTRACK-Run die Nummer derjenigen +c Schleife des ACCEL-files bzw. des 'FoilFiles' mit den gleichen Settings +c berechnen zu koennen. Es wird geprueft, ob die Werte, die die einzelnen +c Parameter jetzt annehmen sollen, auch bei der frueheren Simulation gerechnet +c worden sind. +c In dieser Routine wird auch ueberprueft, ob jedes der jetzt abzuarbeitenden +c Teilchen in der frueheren Simulation gerechnet worden ist, sowie an welcher +c Stelle in 'artList' das jeweilige Teilchen bei der frueheren Simlation stand. + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + + namelist /loop_params/ + + U_Tgt_,U_Gua_,U_G1_,U_L1_,U_Sp_,U_L2_,U_Folie_, B_Helm_,B_TD_, + + alfaTgt_,alfaSp_,alfaTD_,Masse_,Ladung_, + + E0_,y0_,z0_,theta0_,phi0_,deltaL1_,U_KL_ + ! (U_KL_ nur fuer das Einlesen aelterer foilFile-Versionen) + + nameList /additionals/ par_Anzahl_prevSim,reihenFolge_prevSim,artenZahl_prevSim, + + par_Anzahl_AH ,reihenFolge_AH ,artenZahl_AH, + + mappenNameACCEL + +c 'artListIndx_prevSim(i)' enthaelt die Nummer, die das Teilchen, das jetzt bei +c Mutrack an Stelle 'i' in 'artList' steht, waehrend ACCEL bzw. waehrend +c 'FoilFile' innehatte. + + integer par_Anzahl_prevSim,reihenFolge_prevSim(par_Anzahl) + real par_prevSim(3,par_Anzahl),n_par_prevSim(par_Anzahl) + integer artListIndx_prevSim(arten_zahl),artenZahl_prevSim + + COMMON /prevSim/ par_Anzahl_prevSim,reihenFolge_prevSim,par_prevSim,n_par_prevSim + COMMON /prevSim/ artListIndx_prevSim + +c Misc.: + + integer i, par_ + real help, factor + integer firstIndx_,lastIndx_ + + integer pos1,pos2 + + character*4 art,art_prevSim + integer artIndx_prevSim + + real von,bis,step,von_prevSim,bis_prevSim,step_prevSim + integer iHelp,errorNr + +c integer j + + +c fuer Kompatibilitaet mit frueheren Versionen, bei denen statt der Extension +c '_prevSim' noch die Extension '_AH' verwendet wurde: + + integer par_Anzahl_AH /-1.E8/ + integer reihenFolge_AH(par_Anzahl) /par_anzahl*-1.E8/ + integer artenZahl_AH /-1.E8/ + + + +c die lokalen Variablen fuer das Einlesen der Schleifenparameter der freuheren +c Simulation, die dann in das Feld 'par_prevSim' uebertragen werden: + + ! von ! bis ! step ! + + real U_Tgt_(3) / 0. , +1.e10 , -1.e10 / + real U_Gua_(3) / -1.e10 , +1.e10 , -1.e10 / + real U_G1_(3) / 0. , +1.e10 , -1.e10 / + real U_L1_(3) / 0. , +1.e10 , -1.e10 / + real U_Sp_(3) / 0. , +1.e10 , -1.e10 / + real U_L2_(3) / 0. , +1.e10 , -1.e10 / + +c Fuer das Einlesen aelterer foilFile-Versionen: + real U_KL_(3) / -1.e10 , +1.e10 , -1.e10 / + + real U_Folie_(3) / 0. , +1.e10 , -1.e10 / + + real B_Helm_(3) / 0. , +1.e10 , -1.e10 / + real B_TD_(3) / 0. , +1.e10 , -1.e10 / + + real alfaTgt_(3) / 0. , +1.e10 , -1.e10 / + real alfaSp_(3) / 45. , +1.e10 , -1.e10 / + real alfaTD_(3) / 0. , +1.e10 , -1.e10 / + + real Masse_(3) / 105659. , +1.e10 , -1.e10 / + real Ladung_(3) / 1. , +1.e10 , -1.e10 / + + real E0_(3) / 0. , +1.e10 , -1.e10 / + real y0_(3) / 0. , +1.e10 , -1.e10 / + real z0_(3) / 0. , +1.e10 , -1.e10 / + real theta0_(3) / 0. , +1.e10 , -1.e10 / + real phi0_(3) / 0. , +1.e10 , -1.e10 / + + real deltaL1_(3) / 0. , +1.e10 , -1.e10 / + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c in ParAC2ParMu(i,j) steht, welche CodeZahl die jetztige MUTRACK-Version +c fuer denjenigen Parameter verwendet, der von ACCEL (waehrend der vom +c VersionIndx 'j' abgedeckten Versionen) unter der CodeNummer 'i' +c gefuehrt wurde: +c ParAC2ParMu = ParAC2ParMu(parAC,VersionIndx) +c (bei der Zuordnung unbelegte Nummern sind auf Null zu setzen) + + integer ParAC2ParMu(12,2) + DATA ParAC2ParMu / + +c AccelVersionIndx = 1: noch ohne Magnetfelder +c Nummer waehrend ACCEL: +c 1| 2| 3| 4| 5| 6| 7| 8| 9|10|11|12 +c Nummer bei aktueller MUTRACK-Version: + + 1, 2, 3,18,19,20,21,22,23,24, 0, 0, ! AccelVersionIndx = 1 + + 1, 2, 3,13,14,18,19,20,21,22,23,24/ ! AccelVersionIndx = 2 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c in ParMU2ParMu(i,j) steht, welche CodeZahl die jetztige MUTRACK-Version +c fuer denjenigen Parameter verwendet, der waehrend 'foilFile' (waehrend der +c vom VersionIndx 'j' abgedeckten Versionen) unter der CodeNummer 'i' gefuehrt +c wurde: +c ParMu2ParMu = ParMu2ParMu(parMU,VersionIndx) +c (bei der Zuordnung unbelegte Nummern sind auf Null zu setzen) +c (Die vorliegende Mutrack-Version gehoert mit zum hoechsten MutrackVersionIndx. +c Daher gibt es fuer das hoechste 'MutrackVersionIndx' eine eins zu eins Ent- +c sprechung der CodeZahlen, weshalb in der letzten Initialisierungszeile +c fuer 'ParMU2ParMu' einfach die ganzen Zahlen von 1 bis par_Anzahl durchge- +c zaehlt sind. + + integer ParMU2ParMu(par_Anzahl,2) + DATA ParMU2ParMu / +c Nummer waehrend frueherer Version: +c 1| 2| 3| 4| 5| 6| 7| 8| 9|10|11|12|13|14|15|16|17|18|19|20| +c 21|22|23|24|25|26|27|28 +c Nummer jetzt: + + 1, 2, 3, 4, 5, 7, 8, 9,10,11,12,15,16,17,18,19,20,21,22,23, ! indx = 1 + + 24,25,26,27,28, 0, 0, 0, ! indx = 1 + + 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20, ! indx = 2 + + 21,22,23,24,25,26,27,28/ ! indx = 2 + +c------------------------------------------------------------------------------- + +c Lies die Einstellungen der Schleifenparameter waehrend der Simulation mit +c ACCEL bzw. waehrend 'createFoilFile': + + read(lunREAD,nml=loop_params) + rewind(lunREAD) + read(lunREAD,nml=additionals) + rewind(lunREAD) + + ! fuer Kompatibilitaet mit aelteren foilFile-Versionen: + if (U_KL_(1).NE.-1.e10) then + do i = 1, 3 + U_L1_(i) = U_KL_(i) + enddo + endif + +c fuer Kompatibilitaet mit frueheren Versionen, bei denen statt der Extension +c '_prevSim' noch die Extension '_AH' verwendet wurde: + + if (par_Anzahl_AH.NE.-1.E8) par_Anzahl_prevSim = par_Anzahl_AH + if (reihenFolge_AH(1).NE.-1.E8) then + do i = 1, par_Anzahl_prevSim + reihenFolge_prevSim(i) = reihenFolge_AH(i) + enddo + endif + if (artenZahl_AH.NE.-1.E8) artenZahl_prevSim = artenZahl_AH + + +c Ersetze die von Accel bzw. von FoilFile verwendeten Parameter-Codenummern +c durch die von der aktuellen MUTRACK-Version verwendeten Codenummern: + +c write(*,*) 'mutrackVersionIndx = ',mutrackVersionIndx + do i = 1 , par_Anzahl_prevSim + par_ = reihenFolge_prevSim(i) + if (use_accel) then + reihenFolge_prevSim(i) = parAC2parMU(par_,accelVersionIndx) + else ! => use_MUTRACK + reihenFolge_prevSim(i) = parMU2parMU(par_,mutrackVersionIndx) +c write(*,*) par_,' wird zu ',reihenFolge_prevSim(i) + endif + enddo + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Vergleich von 'artList' und 'artList_prevSim': + + if ((artList_prevSim.NE.' ' .AND. .NOT.artList_defined) .OR. + + (artList_prevSim.EQ.' ' .AND. artList_defined) ) then + write(*,*) 'missmatch 111' + call exit + endif + +c Entfernen der embedded blanks aus 'artList_prevSim': + + pos 2 = 0 + do pos1 = 1, len(artList_prevSim) + if(artList_prevSim(pos1:pos1).NE.' ') then + pos2 = pos2 + 1 + artList_prevSim(pos2:pos2) = artList_prevSim(pos1:pos1) + endif + enddo + do pos1 = pos2+1, len(artList_prevSim) + artList_prevSim(pos1:pos1) = ' ' + enddo + + if (artList_defined) then + ! Pruefe fuer jeden Eintrag in 'artlist', ob er auch in 'artList_prevSim' + ! vorhanden ist. Lege die Nummer des entsprechenden Teilchens + ! in 'artList_prevSim' in 'artListIndx_prevSim' ab: + do i = 1, par(2,charge) ! fuer jede Art aus 'artlist' + art = art_Name(art_Nr(i)) + pos1 = 0 + pos2 = 0 + artIndx_prevSim = 0 + do while (pos2.LE.50) + pos2 = Index(artList_prevSim(pos1+1:50),',') + if (pos2.EQ.0) pos2=51 + art_prevSim = artList_prevSim(pos1+1:pos2-1) + artIndx_prevSim = artIndx_prevSim + 1 + if (art.EQ.art_prevSim) then + artListIndx_prevSim(i) = artIndx_prevSim +c write(*,'(x,A,I2)') ' das Teilchen '//art//' hat in ''artList_prevSim'' die Position ',artIndx_prevSim + goto 1 + endif + pos1 = pos2 + enddo + write(*,*) ' Teilchen '//art//' ist nicht im ACCEL-file bzw. ''Foilfile'' enthalten!' + write(*,*) ' ''artList_prevSim'' = ',artList_prevSim + call exit +1 enddo + endif + +c write(*,*) 'artListIndx_prevSim = ',artListIndx_prevSim + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Uebertragen der Schleifenparameter in das Feld 'par_prevSim': + + do i = 1, 3 + + par_prevSim(i,UTgt) = U_Tgt_ (i) + par_prevSim(i,UGua) = U_Gua_ (i) + par_prevSim(i,UG1) = U_G1_ (i) + par_prevSim(i,UL1) = U_L1_ (i) + par_prevSim(i,USp) = U_Sp_ (i) + par_prevSim(i,UL2) = U_L2_ (i) + + par_prevSim(i,UFolie) = U_Folie_ (i) + + par_prevSim(i,BHelm) = B_Helm_ (i) + par_prevSim(i,BTD) = B_TD_ (i) + + par_prevSim(i,alfTgt) = alfaTgt_ (i) + par_prevSim(i,alfSp) = alfaSp_ (i) + par_prevSim(i,alfTD) = alfaTD_ (i) + + par_prevSim(i,mass) = Masse_ (i) + par_prevSim(i,charge) = Ladung_ (i) + par_prevSim(i,ener) = E0_ (i) + par_prevSim(i,yPos) = y0_ (i) + par_prevSim(i,zPos) = z0_ (i) + par_prevSim(i,thetAng) = theta0_ (i) + par_prevSim(i,phiAng) = phi0_ (i) + + par_prevSim(i,DeltaL1) = DeltaL1_ (i) + enddo + + +c Bestimme 'par_prevSim' und 'n_par_prevSim' sowie 'par' und 'n_par' (Fuer +c Kommentare zur Vorgehensweise siehe Subroutine 'adjustLoops'): + + if (artList_defined) then + par_prevSim(1,mass) = 1. + par_prevSim(2,mass) = 1. + par_prevSim(1,charge) = 1. + par_prevSim(2,charge) = artenZahl_prevSim + endif + + do i = 1 , par_Anzahl_prevSim + par_ = reihenFolge_prevSim(i) + +c - PREVIOUS SIMULATION: + + if (par_prevSim(2,par_).NE.1.E10) then ! wurde maxWert vorgegeben? + if (par_prevSim(2,par_).EQ.par_prevSim(1,par_) .OR. par_prevSim(3,par_).EQ.0.) then + par_prevSim(2,par_) = par_prevSim(1,par_) + par_prevSim(3,par_) = 1. + else ! wurde step vorgegeben? + if (par_prevSim(3,par_).EQ.-1.E10) then + par_prevSim(3,par_) = par_prevSim(2,par_) - par_prevSim(1,par_) + endif + endif + else + if (par_.EQ.UGua .AND. par_prevSim(1,UGua).EQ.-1.E10) then + guard = .false. ! default = .true. + par(1,UGua) = 0. + par(2,UGua) = 0. + par_prevSim(1,UGua) = 0. + endif + par_prevSim(2,par_) = par_prevSim(1,par_) + par_prevSim(3,par_) = 1. + endif + factor = 1 + step = par_prevSim(3,par_) +2 do help = par_prevSim(1,par_), par_prevSim(2,par_), step + ! just count the loop index + enddo + if ((help-par_prevSim(2,par_))/step.LT.1.E-4) then + factor = factor - 0.00000003 ! (smallest number that works) + step = par_prevSim(3,par_) * factor + goto 2 + endif + par_prevSim(3,par_) = step + n_par_prevSim(par_) = int((par_prevSim(2,par_)-par_prevSim(1,par_)+par_prevSim(3,par_))/par_prevSim(3,par_) +.5) + if (n_par_prevSim(par_).LE.0) n_par_prevSim(par_)=1 + +c - MUTRACK: + + if (par(2,par_).NE.1.E10) then ! wurde maxWert vorgegeben? + if (par(2,par_).EQ.par(1,par_) .OR. par(3,par_).EQ.0.) then + par(2,par_) = par(1,par_) + par(3,par_) = 1. + else ! wurde step vorgegeben? + if (par(3,par_).EQ.-1.E10) then + par(3,par_) = par(2,par_) - par(1,par_) + endif + endif + else + par(2,par_) = par(1,par_) + par(3,par_) = 1. + endif + factor = 1 + step = par(3,par_) +3 do help = par(1,par_), par(2,par_), step + ! just count the loop index + enddo + if ((help-par(2,par_))/step.LT.1.E-4) then + factor = factor - 0.00000003 ! (smallest number that works) + step = par(3,par_) * factor + goto 3 + endif + par(3,par_) = step + n_par(par_) = int((par(2,par_)-par(1,par_)+par(3,par_))/par(3,par_) +.5) + if (n_par(par_).LE.0) n_par(par_)=1 + enddo + + +c Pruefe, ob die von MUTRACK zu verwendenden Werte eine Teilmenge derjenigen +c Werte darstellen, die von ACCEL bzw. waehrend 'createFoilFile' verwendet +c wurden: + + do i = 1, par_Anzahl_prevSim + par_ = reihenFolge_prevSim(i) + if (par_.EQ.charge.AND.artList_defined) goto 10 + if (n_par(par_).GT.n_par_prevSim(par_)) then + errorNr = 1 + goto 9999 + endif + + von = par(1,par_) + bis = par(2,par_) + step = par(3,par_) + von_prevSim = par_prevSim(1,par_) + bis_prevSim = par_prevSim(2,par_) + step_prevSim = par_prevSim(3,par_) + +c die folgenden Zeilen nochmals ueberpruefen: + + if (n_par(par_).EQ.1) then + if (n_par_prevSim(par_).EQ.1) then + if (von_prevSim.EQ.0) then + if (abs(von.GT.1.E-4)) then + errorNr = 2 + goto 9999 + endif + elseif (abs((von_prevSim-von)/von_prevSim).GT.1.E-4) then + errorNr = 3 + goto 9999 + endif + else + firstIndx_ = int((von-von_prevSim)/step_prevSim + 0.5) + 1 + if ( (firstIndx_.LT.1 .OR. firstIndx_.GT.n_par_prevSim(par_)) .OR. + + (abs((von_prevSim+(firstIndx_-1)*step_prevSim-von)/step_prevSim).GT.1.E-4)) then + errorNr = 4 + goto 9999 + endif + endif + + else + + firstIndx_ = int((von-von_prevSim)/step_prevSim + 0.5) + 1 + if ( (firstIndx_.LT.1 .OR. firstIndx_.GT.n_par_prevSim(par_)) .OR. + + (abs((von_prevSim+(firstIndx_-1)*step_prevSim-von)/step_prevSim).GT.1.E-4)) then + errorNr = 5 + goto 9999 + endif + lastIndx_ = int((bis-von_prevSim)/step_prevSim + 0.5) + 1 + if ( (lastIndx_.LT.1 .OR. lastIndx_.GT.n_par_prevSim(par_)) .OR. + + (abs((von_prevSim+(lastIndx_-1)*step_prevSim-bis)/step_prevSim).GT.1.E-4)) then + if (lastIndx_.LT.1) then + write(*,*) 'I: lastIndx_ = ',lastIndx_ + endif + if (lastIndx_.GT.n_par_prevSim(par_)) then + write(*,*) 'II : lastIndx_ = ',lastIndx_ + write(*,*) 'II : n_par_prevSim(par_) = ',n_par_prevSim(par_) + endif + if ((abs((von_prevSim+(lastIndx_-1)*step_prevSim-bis)/step_prevSim).GT.1.E-4)) then + write(*,*) 'III: lastIndx_-1 = ',lastIndx_-1 + write(*,*) 'III: von_prevSim+(lastIndx_-1)*step_prevSim-bis = ',von_prevSim+(lastIndx_-1)*step_prevSim-bis + write(*,*) 'III: ((von_prevSim+(lastIndx_-1)*step_prevSim-bis)/step_prevSim = ', + + (von_prevSim+(lastIndx_-1)*step_prevSim-bis)/step_prevSim + endif + errorNr = 6 + goto 9999 + endif + iHelp = int(step/step_prevSim + 0.5) + if (abs((iHelp*step_prevSim-step)/step_prevSim).GT.1.E-4) goto 9999 + endif +10 enddo + +c -> falls wir hier ankommen, sind die beiden Parametersaetze kompatibel! + + + RETURN + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +9999 continue ! -> Fehlermeldung + write(*,*) + write(*,*) ' =================================================================' + write(*,*) ' | Mutrack-Vorgabe ist nicht kompatibel mit frueherer Simulation |' + write(*,*) ' | errorCode = ',errorNr,' |' + write(*,*) ' =================================================================' + write(*,*) + write(*,*) + write(*,*) 'par_ = ',par_ + write(*,*) + write(*,*) ' Werte bei frueherer Simulation:' + if (n_par_prevSim(par_).LE.1) then + write (*,*) ' ',par_text(par_)(1:10),' = ',von_prevSim + elseif (n_par_prevSim(par_).EQ.2) then + write (*,*) ' ',par_text(par_)(1:10),' = ',von_prevSim,bis_prevSim + else + write (*,*) ' ',par_text(par_)(1:10),' = ',von_prevSim,bis_prevSim,step_prevSim + endif + write(*,*) ' jetztige Wertevorgabe:' + if (n_par(par_).LE.1) then + write (*,*) ' ',par_text(par_)(1:10),' = ',von + elseif (n_par(par_).EQ.2) then + write (*,*) ' ',par_text(par_)(1:10),' = ',von,bis + else + write (*,*) ' ',par_text(par_)(1:10),' = ',von,bis,step + endif + write(*,*) ' =======================================================' + write(*,*) + call exit + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + integer*4 function firstEventNr() +c ================================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + + real par_prevSim(3,par_Anzahl),n_par_prevSim(par_Anzahl) + integer par_Anzahl_prevSim,reihenFolge_prevSim(par_Anzahl) + integer artListIndx_prevSim(arten_zahl) + + COMMON /prevSim/ par_Anzahl_prevSim,reihenFolge_prevSim,par_prevSim,n_par_prevSim + COMMON /prevSim/ artListIndx_prevSim + + integer qIndxMu + common /qIndxMu/ qIndxMu + + integer loopNr_prevSim,parIndx_prevSim,i,par_ + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + loopNr_prevSim = 1 + do i = 1, par_Anzahl_prevSim + par_ = reihenFolge_prevSim(i) + if (n_par_prevSim(par_).GT.1) then + if (par_.EQ.charge .AND. artList_defined) then + parIndx_prevSim = artListIndx_prevSim(qIndxMu) + write(*,*) + write(*,*) 'parIndx_prevSim = ',parIndx_prevSim + write(*,*) + else + parIndx_prevSim = int( (parWert(par_)-par_prevSim(1,par_))/par_prevSim(3,par_) + 0.5) + 1 + endif + loopNr_prevSim = (loopNr_prevSim-1)*n_par_prevSim(par_) + parIndx_prevSim + endif + enddo + firstEventNr = (loopNr_prevSim-1)*randomStarts_prevSim + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INTEGR_FO.FOR b/mutrack/src/SUB_INTEGR_FO.FOR new file mode 100644 index 0000000..43b3e74 --- /dev/null +++ b/mutrack/src/SUB_INTEGR_FO.FOR @@ -0,0 +1,698 @@ +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_FO +c ======================= + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='FO') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_FO.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + namelist /grid_info/ + + Dx,Dr, imax,jmax, xmax,rmax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + close(lunREAD) + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c die geometrischen Daten fuer Mutrack zusammenstellen: + + MappenLaenge = xmax + + +c Uebergabebereich am MappenEnde definieren: + + xStartUeber = xmax - 0.5*Dx + xEndUeber = xmax + 0.5*Dx + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_FO +c ====================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='FO') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_FO.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP.INC' + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_FO(dt) +c ============================================== + + IMPLICIT NONE + SAVE + + character*(*) Nr + parameter (Nr='Fo') + +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 'MUTRACK.FOR') + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_FO.INC' + + 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 help1,help2 + + 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 bei dt < dtsmall der Fehler + ! immer noch zu gross ist. + + logical found_lower ! obere und untere Grenze fuer dt um + logical found_upper ! Uebergabebereich zu treffen + real dtlower,dtupper + real help + + 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 = .false. + found_upper = .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_FO(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_FO(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_FO(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_FO(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_FO(dt,EFeld0,x,v, Dx2,Dv2 ,*999) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +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 Geschwindikeit (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 = .false. + found_lower = .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 + + +c Falls x(1) (== x_1) jetzt bereits jenseits des Uebergangsbereiches am Ende +c der Potentialmappe liegen sollte, behalte dieses Faktum im Gedaechtnis +c und verkuerze den aktuell verwendeten Zeitschritt so lange um Faktor 0.5, bis +c x(1) innerhalb oder vor dem Uebergabebereich liegt. Liegt es davor, suche +c einen mittleren Zeitschritt, bei dem es im Uebergangsbereich liegt. Schliesse +c dann die Integration in dieser Mappe ab. +c (Der Uebergabebereich geht von einer halben x-Gitterkonstanten vor xmax bis +c eine halbe x-Gitterkonstante hinter xmax. In diesem Bereich wird ein konstantes +c EFeld zurueckgegeben): + + x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15. + + if (x_1.GT.xStartUeber) then + if (x_1.LT.xEndUeber) then + reachedEndOfMap = .true. + else + dtupper = dt + found_upper = .true. + if (.NOT.found_lower) then + dt = min(0.5*dt,(xStartUeber-x(1))/(x_1-x(1))*dt) + else + dt = (dtlower+dtupper)/2. + endif + goto 10 ! neue Berechnung + endif + elseif (found_upper) then + found_lower = .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 naeherungsweisen Schnittpunkt der +c Trajektorie mit x=xmax (exaktes Mappenende) unter Verwendung der im Uebergabebereich +c zurueckgegebenen Beschleunigung: + + if (reachedEndOfMap) then + call EFeld_FO(x,EFeld0,*999) + help = v(1)*v(1) - 2.*EFeld0(1)*Beschl_Faktor*(x(1)-xmax) + if (help.LT.0.) then ! Teilchen wird noch vor Folie reflektiert werden + reachedEndOfMap = .false. + goto 3454 + else + if (EFeld0(1)*Beschl_Faktor.NE.0) then + help = (sqrt(help) - v(1))/(EFeld0(1)*Beschl_Faktor) ! dt -> help + else + help = (xmax-x(1))/v(1) + endif + endif + t = t + help ! auch diesen Zeitschritt addieren +d dt = dt + help ! nur fuer dtmin_Fo,dtmax_Fo + help1 = Beschl_Faktor *help + help2 = help1*help/2. + x(1) = x(1) + v(1)*help + EFeld0(1)*help2 ! == Folie, wenn richtig + x(2) = x(2) + v(2)*help + EFeld0(2)*help2 + x(3) = x(3) + v(3)*help + EFeld0(3)*help2 + v(1) = v(1) + EFeld0(1)*help1 + v(2) = v(2) + EFeld0(2)*help1 + v(3) = v(3) + EFeld0(3)*help1 + RETURN + endif + + +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: +d if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))) + endif + + RETURN + + +c hier folgt der Code fuer 'returnCode_EFeld.NE.0': + +998 continue + + if (returnCode_EFeld.EQ.1) then + write(*,*) Nr//'-Mappe:' + write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!' + write(*,*)' -> STOP' + write(*,*) + STOP + ! alternativ koennte man hier vielleicht auch nach x=xmax zurueckrechnen + endif + +999 continue + + if (returnCode_EFeld.EQ.1) then ! Testort hinter der Mappe + dt = 0.5*dt + found_lower = .false. + found_upper = .false. + goto 10 + endif + if (returnCode_EFeld.EQ.3) then ! Testort vor der Mappe + if (v(1).LE.0) then ! reflektiert -> kann vorkommen + destiny = code_reflektiert + RETURN + else ! in Vorwaertsbewegung -> darf nicht vorkommen!! + write(*,*) + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*)' Test-x liegt vor der Mappe! x,y,z = ',x + write(*,*)' Teilchen-Nr = ',Start_Nr(1) + write(*,*)' -> STOP' + write(*,*) + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_FO(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'. Die Formeln sind zwar teilweise +c etwas umgeschrieben, sind aber mathematisch alle aequivalent zu denen der +c Referenz. + +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_Fo/ 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_FO(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_FO(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_FO(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_FO(x,E,*) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_FO.INC' + + real real_i,real_j ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real radius ! Betrag des Radiusvektors in y-z-Ebene + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + real Erad ! radiale Feldstaerke + + +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 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Rechne in Gittereinheiten um: + + radius = sqrt(x(2)*x(2)+x(3)*x(3)) + + real_i = (x(1) - xEnterMap) / Dx + real_j = radius / Dr ! 'Mutrack' statt + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Mache die Tests und berechne die Feldstaerke: + +c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt: + + if (real_j.GT.jmax) then ! => radial ausserhalb der Mappe + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN + elseif (real_i.GT.real(imax)) then ! => hinter Potentialmappe, also + ! hinter TriggerFolie + if (real_i.GT.real(imax)+.5) then + returnCode_EFeld = 1 + RETURN 1 + else + real_i = imax + endif + elseif (real_i.LT.0.) then ! => vor Beginn der Potentialmappe + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN +c else +c returnCode_EFeld = 0 + endif + + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c +c Potentialverlauf ist symmetrisch zu j=0 (Linsenachse): +c +c map(i,-j) == map(i,j). +c +c Entlang j=0 ist also Erad=0 und damit E(2)=0 und E(3)=0. +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = map(ihelp-1) - map(ihelp) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1)) + E(1) = E(1) / Dx ! Reskalierung entsprechend x-Gitterkonstanten + + +c Berechne die radiale Komponente der Feldstaerke: + + if (real_j.LT.1e-10) then + E(2) = 0. + E(3) = 0. + RETURN + endif + + j = stuetzstelle_j(1) + + do n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = map(ihelp-(imax+1)) - map(ihelp) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + Erad = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + Erad = Erad / Dr ! Reskalierung entsprechend r-Gitterkonstanten + + +c Berechne E(2) und E(3) aus Erad: + + E(2) = Erad * x(2) / radius + E(3) = Erad * x(3) / radius + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INTEGR_L1.FOR b/mutrack/src/SUB_INTEGR_L1.FOR new file mode 100644 index 0000000..727c6c9 --- /dev/null +++ b/mutrack/src/SUB_INTEGR_L1.FOR @@ -0,0 +1,629 @@ +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFOS +c ===================== + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + logical map_error /.false./ + COMMON /map_error/ map_error + +c if (.NOT.Use_MUTRACK .OR. write_geo) then + CALL READ_INFO_L1 + if (.NOT.idealMirror) then + call read_INFO_SP_1 + call read_INFO_SP_2 + call read_INFO_SP_3 + endif + if (lense2) CALL READ_INFO_L2andFo + if (TriggerInBeam) CALL READ_INFO_FO +c endif + if (.NOT.upTOTDFoilOnly) then + CALL READ_INFO_L3 + CALL READ_INFO_M2 + endif + + if (map_error) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + call exit + endif + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_L1 +c ======================= + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='L1') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L1.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + namelist /geometry/ + + DistanceCyl,iRadiusCyl, + + LengthOuterCyl,oRadiusOuterCyl, + + LengthInnerCyl,oRadiusInnerCyl, + + RadiusVacTube + + namelist /grid_info/ + + Dx,Dr, imax,jmax, xmax,rmax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + rewind (lunREAD) + read (lunREAD,nml=geometry) + close (lunREAD) + + +c Pruefen, ob die eingelesene Mappe den Anforderungen genuegt: + + if (iRadiusCyl.NE.rmax) then + write(*,*)' L1-Mappe: rmax der Mappe stimmt nicht mit Innenradius der Zylinder ueberein' + write(*,*)' -> STOP' + STOP + endif + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c die geometrischen Daten fuer Mutrack zusammenstellen: + + xEnterMap = xCenterOfLense - xmax + xLeaveMap = xCenterOfLense + xmax + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_L1 +c ====================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='L1') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L1.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP.INC' + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_L1(dt) +c ============================================== + + IMPLICIT NONE + SAVE + + character*(*) Nr + parameter (Nr='L1') + +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 'MUTRACK.FOR') + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L1.INC' + + 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 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 bei dt < dtsmall der Fehler + ! immer noch zu gross ist. + + 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 + 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_L1(x,EFeld0,*999) + + +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_L1(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_L1(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_L1(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_L1(dt,EFeld0,x,v, Dx2,Dv2 ,*999) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +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 Geschwindikeit (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) + + maxErr = Max(maxErr_x,maxErr_v) + + if (maxErr.GT.1.) then + 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 + + +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) + Dx1(1) + xDifferenz(1) / 15. + 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, neuen so gross wie sinnvoller weise moeglich +c machen: + + t = t + dt + 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: +d if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))) + endif + + + RETURN + + +c hier folgt der Code fuer 'returnCode_EFeld.NE.0': + +999 continue + + if (returnCode_EFeld.EQ.2) then + destiny = code_wand + RETURN + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_L1(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'. Die Formeln sind zwar teilweise +c etwas umgeschrieben, sind aber mathematisch alle aequivalent zu denen der +c Referenz. + +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_L1/ 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_L1(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_L1(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_L1(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_L1(x,E,*) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L1.INC' + + real real_i,real_j ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real radius ! Betrag des Radiusvektors in y-z-Ebene + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + real Erad ! radiale Feldstaerke + + +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 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Rechne in Gittereinheiten um: + + radius = sqrt(x(2)*x(2)+x(3)*x(3)) + + real_i = (xmax - abs(x(1)-xCenterOfLense)) / Dx + real_j = radius / Dr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Mache die Tests und berechne die Feldstaerke: + +c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt: + + if (real_j.GT.jmax) then + returnCode_EFeld = 2 + RETURN 1 + elseif (real_i.LT.0.) then + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN +c else +c returnCode_EFeld = 0 + endif + + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c +c Potentialverlauf ist symmetrisch zu real_i = imax (Mittelebene des inneren +c Zylinders) und zu j=0 (Linsenachse): +c +c map(imax+i,-j) == map(imax-1,j), +c map(i,-j) == map(i,j). +c +c Entlang j=0 ist also Erad=0 und damit E(2)=0 und E(3)=0, bei i=imax ist E(1)=0 +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = 2. * Abstand_i *(map(ihelp)-map(ihelp-1)) ! i=imax -> map(imax+1,j) = map(imax-1,j) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1)) + E(1) = E(1) / Dx ! Reskalierung entsprechend x-Gitterkonstanten + if (x(1).GT.xCenterOfLense) E(1) = - E(1) + + +c Berechne die radiale Komponente der Feldstaerke: + + if (real_j.LT.1e-10) then + E(2) = 0. + E(3) = 0. + RETURN + endif + + j = stuetzstelle_j(1) + + do n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = map(ihelp-(imax+1)) - map(ihelp) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + Erad = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + Erad = Erad / Dr ! Reskalierung entsprechend r-Gitterkonstanten + + +c Berechne E(2) und E(3) aus Erad: + + E(2) = Erad * x(2) / radius + E(3) = Erad * x(3) / radius + + +cd write(18,*)'x,E = ',x,E + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INTEGR_L2ANDFO.FOR b/mutrack/src/SUB_INTEGR_L2ANDFO.FOR new file mode 100644 index 0000000..3724b8a --- /dev/null +++ b/mutrack/src/SUB_INTEGR_L2ANDFO.FOR @@ -0,0 +1,802 @@ +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_L2andFo +c ============================ + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='L2andFo') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L2andFo.INC' + + real DistanceMapToFirst ! Der Beginn der Linse relativ zum Beginn der + ! Potentialmappe + +c nur fuer Einlesen des INFO-files: + + real DistCenterToFoil ! Abstand zwischen Linsenmitte und TD-Folie + real rFoil ! Radius der TD-Folien-Scheibe bei Relaxation + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + namelist /geometry/ + + DistanceMapToFirst, + + DistanceCyl,iRadiusCyl, + + LengthOuterCyl,oRadiusOuterCyl, + + LengthInnerCyl,oRadiusInnerCyl, + + RadiusVacTube,DistCenterToFoil,rFoil + + namelist /grid_info/ + + Dx,Dr, imax,jmax, xmax,rmax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunTMP,file=mappenName//'.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunTMP,nml=grid_info) + rewind (lunTMP) + read (lunTMP,nml=geometry) + close (lunTMP) + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c die geometrischen Daten fuer Mutrack zusammenstellen (Kammer-System): + + xEnterMap = xCenterOfLense - (0.5*LengthInnerCyl + DistanceCyl + + + LengthOuterCyl + DistanceMapToFirst) + xLeaveMap = xEnterMap + xmax + xEndLense = xCenterOfLense + (0.5*LengthInnerCyl + DistanceCyl + + + LengthOuterCyl) + + +c Uebergabebereich am MappenEnde definieren (MappenSystem!): + + xStartUeber = xMax - 0.5*Dx + xEndUeber = xMax + 0.5*Dx + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE ADD_MAP_L2andFo +c ========================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='L2andFo') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L2andFo.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + + real U_L2 + COMMON /U_L2/ U_L2 + INCLUDE 'mutrack$sourcedirectory:COM_TD_EXT.INC' ! um U_F zu haben + + integer i,j, ihelp, iostat + + integer iReadMax + parameter (iReadMax=1000) + real read_memory(0:iReadMax) + COMMON /read_memory/ read_memory ! COMMON nur, damit nicht jede + ! Mappe extra Speicher belegt. + + +c Pruefe, ob genug Speicherplatz zur Verfuegung steht: + + if (imax.GT.iReadMax) then + write(*,*) + write(*,*) 'parameter ''iReadMax'' in Subroutine ADD_MAP_'//Nr//' is too small' + write(*,*) ' iMax, iReadMax = ',iMax, iReadMax + write(*,*) + write(*,*) '=> please adjust!' + write(*,*) + call exit + endif + + +c Einlesen der 'L2Fo_L2'-Potentialmappe: + + open (lunTMP,file=mappenName//'_L2.MAPPE', + + defaultfile=mappenDir,status='old', + + form='unformatted',recl=imax+1,readonly) +c + form='unformatted',recl=imax,readonly) + do j = 0, jmax + ihelp = j*(imax+1) + read(lunTMP,iostat=iostat) (map(ihelp+i),i=0,imax) + if (iostat.NE.0) then + write(*,*) + write(*,999) i,j,iostat + write(*,*)' Potentialmappe: ',mappenName + write(*,*)' Directory : ',mappenDir + write(*,*) + CALL EXIT + endif + enddo + close(lunTMP) +999 format(7x'error reading grid point (i,j) = ('i4','i4')'/7x'iostat = 'i4) + + +c Angleichen der Potentialmappe an U_L2: + + ihelp = 0 + do j=0, jmax + do i=0, imax + map(ihelp) = U_L2*abs(map(ihelp)) + ihelp = ihelp + 1 + enddo + enddo + + +c Einlesen der 'L2Fo_Fo'-Potentialmappe und Angleichen an U_F: + + open (lunTMP,file=mappenName//'_Fo.MAPPE', + + defaultfile=mappenDir,status='old', + + form='unformatted',recl=imax+1,readonly) +c + form='unformatted',recl=imax,readonly) + ihelp = 0 + do j = 0, jmax + read(lunTMP,iostat=iostat) (read_memory(i),i=0,imax) + if (iostat.NE.0) then + write(*,*) + write(*,999) i,j,iostat + write(*,*)' Potentialmappe: ',mappenName + write(*,*)' Directory : ',mappenDir + write(*,*) + CALL EXIT + endif + do i=0, imax + map(ihelp) = map(ihelp) + U_F*abs(read_memory(i)) + ihelp = ihelp + 1 + enddo + enddo + close(lunTMP) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_L2(dt) +c ============================================== + + IMPLICIT NONE + SAVE + + character*(*) Nr + parameter (Nr='L2andFo') + +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 'MUTRACK.FOR') + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L2andFo.INC' + + 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 help1,help2 + + 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 bei dt < dtsmall der Fehler + ! immer noch zu gross ist. + + logical found_lower ! obere und untere Grenze fuer dt um + logical found_upper ! Uebergabebereich zu treffen + real dtlower,dtupper + real help + + 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 = .false. + found_upper = .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_L2andFo(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_L2andFo(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_L2andFo(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_L2andFo(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_L2andFo(dt,EFeld0,x,v, Dx2,Dv2 ,*999) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +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 Geschwindikeit (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 = .false. + found_lower = .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 + + +c Falls x(1) (== x_1) jetzt bereits jenseits des Uebergangsbereiches am Ende +c der Potentialmappe liegen sollte, behalte dieses Faktum im Gedaechtnis +c und verkuerze den aktuell verwendeten Zeitschritt so lange um Faktor 0.5, bis +c x(1) innerhalb oder vor dem Uebergabebereich liegt. Liegt es davor, suche +c einen mittleren Zeitschritt, bei dem es im Uebergangsbereich liegt. Schliesse +c dann die Integration in dieser Mappe ab. +c (Der Uebergabebereich geht von einer halben x-Gitterkonstanten vor xmax bis +c eine halbe x-Gitterkonstante hinter xmax. In diesem Bereich wird ein konstantes +c EFeld zurueckgegeben): + + x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15. + + if (x_1.GT.xStartUeber) then + if (x_1.LT.xEndUeber) then + reachedEndOfMap = .true. + else + dtupper = dt + found_upper = .true. + if (.NOT.found_lower) then + dt = min(0.5*dt,(xStartUeber-x(1))/(x_1-x(1))*dt) + else + dt = (dtlower+dtupper)/2. + endif + goto 10 ! neue Berechnung + endif + elseif (found_upper) then + found_lower = .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 naeherungsweisen Schnittpunkt der +c Trajektorie mit x=xmax (exaktes Mappenende) unter Verwendung der im Uebergabebereich +c zurueckgegebenen Beschleunigung: + + if (reachedEndOfMap) then + call EFeld_L2andFO(x,EFeld0,*999) + help = v(1)*v(1) - 2.*EFeld0(1)*Beschl_Faktor*(x(1)-xmax) + if (help.LT.0.) then ! Teilchen wird noch vor Folie reflektiert werden + reachedEndOfMap = .false. + goto 3454 + else + if (EFeld0(1)*Beschl_Faktor.NE.0) then + help = (sqrt(help) - v(1))/(EFeld0(1)*Beschl_Faktor) ! dt -> help + else + help = (xmax-x(1))/v(1) + endif + endif + t = t + help ! auch diesen Zeitschritt addieren +d dt = dt + help ! nur fuer dtmin_L2andFO,dtmax_L2andFO + help1 = Beschl_Faktor *help + help2 = help1*help/2. +c x(1) = x(1) + v(1)*help + EFeld0(1)*help2 ! == Folie, wenn richtig + x(1) = xmax + x(2) = x(2) + v(2)*help + EFeld0(2)*help2 + x(3) = x(3) + v(3)*help + EFeld0(3)*help2 + v(1) = v(1) + EFeld0(1)*help1 + v(2) = v(2) + EFeld0(2)*help1 + v(3) = v(3) + EFeld0(3)*help1 + RETURN + endif + + +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: +d if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))) + endif + + RETURN + + +c hier folgt der Code fuer 'returnCode_EFeld.NE.0': + +998 continue + + if (returnCode_EFeld.EQ.1) then + write(*,*) Nr//'-Mappe:' + write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!' + write(*,*)' -> STOP' + write(*,*) + CALL EXIT + ! alternativ koennte man hier vielleicht auch nach x=xmax zurueckrechnen + endif + +999 continue + + if (returnCode_EFeld.EQ.1) then ! Testort hinter der Mappe + dt = 0.5*dt + found_lower = .false. + found_upper = .false. + goto 10 + elseif (returnCode_EFeld.EQ.2) then + !destiny = code_wand ! wird im Hauptprogramm zugewiesen! + RETURN + elseif (returnCode_EFeld.EQ.3) then ! Testort vor der Mappe + if (v(1).LE.0) then ! reflektiert -> kann vorkommen + destiny = code_reflektiert + RETURN + else ! in Vorwaertsbewegung -> darf nicht vorkommen!! + write(*,*) + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*)' Test-x liegt vor der Mappe! x,y,z = ',x + write(*,*)' Teilchen-Nr = ',Start_Nr(1) + write(*,*)' -> STOP' + write(*,*) + CALL EXIT + endif + elseif (returnCode_EFeld.NE.0) then + write(*,*) + write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': ' + write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld + write(*,*) '-> STOP' + write(*,*) + CALL EXIT + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_L2andFo(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'. Die Formeln sind zwar teilweise +c etwas umgeschrieben, sind aber mathematisch alle aequivalent zu denen der +c Referenz. + +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_L2andFo(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_L2andFo(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_L2andFo(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_L2andFo(x,E,*) +c =============================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L2andFo.INC' + + real real_i,real_j ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real radius ! Betrag des Radiusvektors in y-z-Ebene + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + real Erad ! radiale Feldstaerke + + +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 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Rechne in Gittereinheiten um: + + radius = sqrt(x(2)*x(2)+x(3)*x(3)) + + real_i = x(1) / Dx ! bereits im Hauptprogr.: x(1) -> x(1)-xEnterMap + real_j = radius / Dr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Mache die Tests und berechne die Feldstaerke: + +c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt: + + if (real_i.GT.real(imax)) then ! => hinter Potentialmappe, also + ! hinter TriggerFolie + if (real_i.GT.real(imax)+.5) then + returnCode_EFeld = 1 + RETURN 1 + else + real_i = imax + endif + elseif (real_j.GT.jmax) then ! => radial ausserhalb der Mappe + returnCode_EFeld = 2 + RETURN 1 + elseif (real_i.LT.0.) then ! => vor Beginn der Potentialmappe + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN + endif + + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c +c Potentialverlauf ist symmetrisch zu j=0 (Linsenachse): +c +c map(i,-j) == map(i,j). +c +c Entlang j=0 ist also Erad=0 und damit E(2)=0 und E(3)=0. +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = map(ihelp-1) - map(ihelp) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1)) + E(1) = E(1) / Dx ! Reskalierung entsprechend x-Gitterkonstanten + + +c Berechne die radiale Komponente der Feldstaerke: + + if (real_j.LT.1e-10) then + E(2) = 0. + E(3) = 0. + RETURN + endif + + j = stuetzstelle_j(1) + + do n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = map(ihelp-(imax+1)) - map(ihelp) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + Erad = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + Erad = Erad / Dr ! Reskalierung entsprechend r-Gitterkonstanten + + +c Berechne E(2) und E(3) aus Erad: + + E(2) = Erad * x(2) / radius + E(3) = Erad * x(3) / radius + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INTEGR_L3.FOR b/mutrack/src/SUB_INTEGR_L3.FOR new file mode 100644 index 0000000..2530e62 --- /dev/null +++ b/mutrack/src/SUB_INTEGR_L3.FOR @@ -0,0 +1,709 @@ +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_L3 +c ======================= + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='L3') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L3.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + namelist /geometry/ + + DistanceCyl,iRadiusCyl, + + LengthOuterCyl,oRadiusOuterCyl, + + LengthInnerCyl,oRadiusInnerCyl, + + RadiusVacTube + + namelist /grid_info/ + + Dx,Dr, imax,jmax, xmax,rmax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + rewind (lunREAD) + read (lunREAD,nml=geometry) + close (lunREAD) + + +c Pruefen, ob die eingelesene Mappe den Anforderungen genuegt: + + if (iRadiusCyl.NE.rmax) then + write(*,*)' L3-Mappe: rmax der Mappe stimmt nicht mit Innenradius der Zylinder ueberein' + write(*,*)' -> STOP' + STOP + endif + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c die geometrischen Daten fuer Mutrack zusammenstellen: + + xEnterMap = xCenterOfLense - xmax + xLeaveMap = xCenterOfLense + xmax + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_L3 +c ====================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='L3') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L3.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP.INC' + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_L3(dt) +c ============================================== + + IMPLICIT NONE + SAVE + + character*(*) Nr + parameter (Nr='L3') + +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 'MUTRACK.FOR') + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L3.INC' + + 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 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 bei dt < dtsmall der Fehler + ! immer noch zu gross ist. + + 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 + 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_L3(x,EFeld0,*999) + + +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_L3(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_L3(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_L3(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_L3(dt,EFeld0,x,v, Dx2,Dv2 ,*999) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +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 Geschwindikeit (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) + + maxErr = Max(maxErr_x,maxErr_v) + + if (maxErr.GT.1.) then + 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 + + +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) + Dx1(1) + xDifferenz(1) / 15. + 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, neuen so gross wie sinnvoller weise moeglich +c machen: + + t = t + dt + 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: +d if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))) + endif + + + RETURN + + +c hier folgt der Code fuer 'returnCode_EFeld.NE.0': + +999 continue + + if (returnCode_EFeld.EQ.2) then + destiny = code_wand + RETURN + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_L3(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'. Die Formeln sind zwar teilweise +c etwas umgeschrieben, sind aber mathematisch alle aequivalent zu denen der +c Referenz. + +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_L3/ 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_L3(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_L3(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_L3(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 + + +cc was hier kommt ist die etwas ausfuehrlichere Version: + +cc First step of Runge-Kutta-Method: dx1, dv1 +c dx1(1) = vIn(1) * dt_ +c dx1(2) = vIn(2) * dt_ +c dx1(3) = vIn(3) * dt_ +c dv1(1) = a0(1) * dt_ +c dv1(2) = a0(2) * dt_ +c dv1(3) = a0(3) * dt_ +cc Second step of Runge-Kutta-Method: dx2, dv2 +c xTest(1) = xIn(1) + dx1(1) / 2. +c xTest(2) = xIn(2) + dx1(2) / 2. +c xTest(3) = xIn(3) + dx1(3) / 2. +c vTest(1) = vIn(1) + dv1(1) / 2. +c vTest(2) = vIn(2) + dv1(2) / 2. +c vTest(3) = vIn(3) + dv1(3) / 2. +c call EFeld_L3(xTest,ETest) +c if (returnCode_EFeld.NE.0) RETURN +c dx2(1) = vTest(1) * dt_ +c dx2(2) = vTest(2) * dt_ +c dx2(3) = vTest(3) * dt_ +c dv2(1) = Beschl_Faktor * ETest(1) * dt_ +c dv2(2) = Beschl_Faktor * ETest(2) * dt_ +c dv2(3) = Beschl_Faktor * ETest(3) * dt_ +cc Third step of Runge-Kutta-Method: dx3, dv3 +c xTest(1) = xIn(1) + dx2(1) / 2. +c xTest(2) = xIn(2) + dx2(2) / 2. +c xTest(3) = xIn(3) + dx2(3) / 2. +c vTest(1) = vIn(1) + dv2(1) / 2. +c vTest(2) = vIn(2) + dv2(2) / 2. +c vTest(3) = vIn(3) + dv2(3) / 2. +c call EFeld_L3(xTest,ETest) +c if (returnCode_EFeld.NE.0) RETURN +c dx3(1) = vTest(1) * dt_ +c dx3(2) = vTest(2) * dt_ +c dx3(3) = vTest(3) * dt_ +c dv3(1) = Beschl_Faktor * ETest(1) * dt_ +c dv3(2) = Beschl_Faktor * ETest(2) * dt_ +c dv3(3) = Beschl_Faktor * ETest(3) * dt_ +cc Fourth step of Runge-Kutta-Method: dx4, dv4 +c xTest(1) = xIn(1) + dx3(1) +c xTest(2) = xIn(2) + dx3(2) +c xTest(3) = xIn(3) + dx3(3) +c vTest(1) = vIn(1) + dv2(1) +c vTest(2) = vIn(2) + dv2(2) +c vTest(3) = vIn(3) + dv2(3) +c call EFeld_L3(xTest,ETest) +c if (returnCode_EFeld.NE.0) RETURN +c dx4(1) = vTest(1) * dt_ +c dx4(2) = vTest(2) * dt_ +c dx4(3) = vTest(3) * dt_ +c dv4(1) = Beschl_Faktor * ETest(1) * dt_ +c dv4(2) = Beschl_Faktor * ETest(2) * dt_ +c dv4(3) = Beschl_Faktor * ETest(3) * dt_ +cc calculate forward step: +c Dx(1) = (dx1(1)+2.*dx2(1)+2.*dx3(1)+dx4(1)) / 6. +c Dx(2) = (dx1(2)+2.*dx2(2)+2.*dx3(2)+dx4(2)) / 6. +c Dx(3) = (dx1(3)+2.*dx2(3)+2.*dx3(3)+dx4(3)) / 6. +c Dv(1) = (dv1(1)+2.*dv2(1)+2.*dv3(1)+dv4(1)) / 6. +c Dv(2) = (dv1(2)+2.*dv2(2)+2.*dv3(2)+dv4(2)) / 6. +c Dv(3) = (dv1(3)+2.*dv2(3)+2.*dv3(3)+dv4(3)) / 6. + +cc was jetzt kommt ist die falsche alte Version!!!!! + +cc First step of Runge-Kutta-Method: dx1, dv1 +c dv1(1) = a0(1) * dt_ +c dv1(2) = a0(2) * dt_ +c dv1(3) = a0(3) * dt_ +c dx1(1) = vIn(1) * dt_ +c dx1(2) = vIn(2) * dt_ +c dx1(3) = vIn(3) * dt_ +cc Second step of Runge-Kutta-Method: dx2, dv2 +c xTest(1)= xIn(1) + dx1(1) / 2. +c xTest(2)= xIn(2) + dx1(2) / 2. +c xTest(3)= xIn(3) + dx1(3) / 2. +c call EFeld_L3(xTest,ETest) +c if (returnCode_EFeld.NE.0) RETURN +c dv2(1)= Beschl_Faktor * ETest(1) * dt_ +c dv2(2)= Beschl_Faktor * ETest(2) * dt_ +c dv2(3)= Beschl_Faktor * ETest(3) * dt_ +c dx2(1) = dx1(1) + dt_ * dv1(1) / 2. +c dx2(2) = dx1(2) + dt_ * dv1(2) / 2. +c dx2(3) = dx1(3) + dt_ * dv1(3) / 2. +cc Third step of Runge-Kutta-Method: dx3, dv3 +c xTest(1)= xIn(1) + dx2(1) / 2. +c xTest(2)= xIn(2) + dx2(2) / 2. +c xTest(3)= xIn(3) + dx2(3) / 2. +c call EFeld_L3(xTest,ETest) +c if (returnCode_EFeld.NE.0) RETURN +c dv3(1)= Beschl_Faktor * ETest(1) * dt_ +c dv3(2)= Beschl_Faktor * ETest(2) * dt_ +c dv3(3)= Beschl_Faktor * ETest(3) * dt_ +c dx3(1) = dx1(1) + dt_ * dv2(1) / 2. +c dx3(2) = dx1(2) + dt_ * dv2(2) / 2. +c dx3(3) = dx1(3) + dt_ * dv2(3) / 2. +cc Fourth step of Runge-Kutta-Method: dx4, dv4 +c xTest(1)= xIn(1) + dx3(1) +c xTest(2)= xIn(2) + dx3(2) +c xTest(3)= xIn(3) + dx3(3) +c call EFeld_L3(xTest,ETest) +c if (returnCode_EFeld.NE.0) RETURN +c dv4(1)= Beschl_Faktor * ETest(1) * dt_ +c dv4(2)= Beschl_Faktor * ETest(2) * dt_ +c dv4(3)= Beschl_Faktor * ETest(3) * dt_ +c dx4(1) = dx1(1) + dt_ * dv3(1) +c dx4(2) = dx1(2) + dt_ * dv3(2) +c dx4(3) = dx1(3) + dt_ * dv3(3) +cc calculate forward step: +c Dx(1) = (dx1(1)+2.*dx2(1)+2.*dx3(1)+dx4(1)) / 6. +c Dx(2) = (dx1(2)+2.*dx2(2)+2.*dx3(2)+dx4(2)) / 6. +c Dx(3) = (dx1(3)+2.*dx2(3)+2.*dx3(3)+dx4(3)) / 6. +c Dv(1) = (dv1(1)+2.*dv2(1)+2.*dv3(1)+dv4(1)) / 6. +c Dv(2) = (dv1(2)+2.*dv2(2)+2.*dv3(2)+dv4(2)) / 6. +c Dv(3) = (dv1(3)+2.*dv2(3)+2.*dv3(3)+dv4(3)) / 6. + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE EFeld_L3(x,E,*) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_L3.INC' + + real real_i,real_j ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real radius ! Betrag des Radiusvektors in y-z-Ebene + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + real Erad ! radiale Feldstaerke + + +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 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Rechne in Gittereinheiten um: + + radius = sqrt(x(2)*x(2)+x(3)*x(3)) + + real_i = (xmax - abs(x(1)-xCenterOfLense)) / Dx + real_j = radius / Dr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Mache die Tests und berechne die Feldstaerke: + +c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt: + + if (real_j.GT.jmax) then + returnCode_EFeld = 2 + RETURN 1 + elseif (real_i.LT.0.) then + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN +c else +c returnCode_EFeld = 0 + endif + + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c +c Potentialverlauf ist symmetrisch zu real_i = imax (Mittelebene des inneren +c Zylinders) und zu j=0 (Linsenachse): +c +c map(imax+i,-j) == map(imax-1,j), +c map(i,-j) == map(i,j). +c +c Entlang j=0 ist also Erad=0 und damit E(2)=0 und E(3)=0, bei i=imax ist E(1)=0 +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = 2. * Abstand_i *(map(ihelp)-map(ihelp-1)) ! i=imax -> map(imax+1,j) = map(imax-1,j) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1)) + E(1) = E(1) / Dx ! Reskalierung entsprechend x-Gitterkonstanten + if (x(1).GT.xCenterOfLense) E(1) = - E(1) + + +c Berechne die radiale Komponente der Feldstaerke: + + if (real_j.LT.1e-10) then + E(2) = 0. + E(3) = 0. + RETURN + endif + + j = stuetzstelle_j(1) + + do n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = map(ihelp-(imax+1)) - map(ihelp) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + Erad = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + Erad = Erad / Dr ! Reskalierung entsprechend r-Gitterkonstanten + + +c Berechne E(2) und E(3) aus Erad: + + E(2) = Erad * x(2) / radius + E(3) = Erad * x(3) / radius + + +cd write(18,*)'x,E = ',x,E + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INTEGR_M2.FOR b/mutrack/src/SUB_INTEGR_M2.FOR new file mode 100644 index 0000000..2e9e3af --- /dev/null +++ b/mutrack/src/SUB_INTEGR_M2.FOR @@ -0,0 +1,721 @@ +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_M2 +c ======================= + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='M2') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_M2.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + namelist /grid_info/ + + Dx,Dr, imax,jmax, xmax,rmax + + namelist /geometry/ + + xMCPfront,diamMCP,thickMCP,xFlansch,rTube + + real xMCPfront,diamMCP,thickMCP,xFlansch,rTube + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + rewind(lunREAD) + read (lunREAD,nml=geometry) + close (lunREAD) + + radius_MCP2 = diamMCP / 2. + + +c Pruefen, ob die eingelesene Mappe den Anforderungen genuegt: + + if (xMCPfront.NE.xmax) then + write(*,*)' M2-Mappe: Mappenende stimmt nicht mit MCP2-Vorderseite ueberein' + write(*,*)' -> STOP' + STOP + endif + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c die geometrischen Daten fuer Mutrack zusammenstellen: + + xEnterMap = xMCP2-xmax + + +c Uebergabebereich am MappenEnde definieren: + + xStartUeber = xMCP2 - 0.5*Dx + xEndUeber = xMCP2 + 0.5*Dx + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_M2 +c ====================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='M2') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_M2.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP.INC' + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_M2(dt) +c ============================================== + + IMPLICIT NONE + SAVE + + character*(*) Nr + parameter (Nr='M2') + +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 'MUTRACK.FOR') + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_M2.INC' + + 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 help,help1,help2 + + 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 bei dt < dtsmall der Fehler + ! immer noch zu gross ist. + + logical found_lower ! obere und untere Grenze fuer dt um + logical found_upper ! 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 = .false. + found_upper = .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_M2(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_M2(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_M2(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_M2(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_M2(dt,EFeld0,x,v, Dx2,Dv2 ,*999) + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +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 Geschwindikeit (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 = .false. + found_lower = .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 + + +c Falls x(1) (== x_1) jetzt bereits jenseits des Uebergangsbereiches am Ende +c der Potentialmappe liegen sollte, behalte dieses Faktum im Gedaechtnis +c und verkuerze den aktuell verwendeten Zeitschritt so lange um Faktor 0.5, bis +c x(1) innerhalb oder vor dem Uebergabebereich liegt. Liegt es davor, suche +c einen mittleren Zeitschritt, bei dem es im Uebergangsbereich liegt. Schliesse +c dann die Integration in dieser Mappe ab. +c (Der Uebergabebereich geht von einer halben x-Gitterkonstanten vor xmax bis +c eine halbe x-Gitterkonstante hinter xmax. In diesem Bereich wird ein konstantes +c EFeld zurueckgegeben): + + x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15. + + if (x_1.GT.xStartUeber) then + if (x_1.LT.xEndUeber) then + reachedEndOfMap = .true. + else + dtupper = dt + found_upper = .true. + if (.NOT.found_lower) then + dt = min(0.5*dt,(xStartUeber-x(1))/(x_1-x(1))*dt) + else + dt = (dtlower+dtupper)/2. + endif + goto 10 ! neue Berechnung + endif + elseif (found_upper) then + found_lower = .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 naeherungsweisen Schnittpunkt der +c Trajektorie mit x=xmax (exaktes Mappenende) unter Verwendung der im Uebergabebereich +c zurueckgegebenen Beschleunigung: + + if (reachedEndOfMap) then + call EFeld_M2(x,EFeld0,*999) + help = v(1)*v(1) - 2.*EFeld0(1)*Beschl_Faktor*(x(1)-xMCP2) + if (help.LT.0.) then ! Teilchen wird noch vor MCP2 reflektiert werden + reachedEndOfMap = .false. + goto 3454 + else + if (EFeld0(1)*Beschl_Faktor.NE.0) then + help = (sqrt(help) - v(1))/(EFeld0(1)*Beschl_Faktor) ! dt -> help + else + help = (xMCP2-x(1))/v(1) + endif + endif + t = t + help ! auch diesen Zeitschritt addieren +d dt = dt + help ! nur fuer dtmin_M2,dtmax_M2 + help1 = Beschl_Faktor *help + help2 = help1*help/2. + x(1) = x(1) + v(1)*help + EFeld0(1)*help2 ! == xMCP2, wenn richtig + x(2) = x(2) + v(2)*help + EFeld0(2)*help2 + x(3) = x(3) + v(3)*help + EFeld0(3)*help2 + v(1) = v(1) + EFeld0(1)*help1 + v(2) = v(2) + EFeld0(2)*help1 + v(3) = v(3) + EFeld0(3)*help1 + + RETURN + endif + + +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: +d if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))) + endif + + + RETURN + + +c hier folgt der Code fuer 'returnCode_EFeld.NE.0': + +998 continue + + if (returnCode_EFeld.EQ.1) then + write(*,*) Nr//'-Mappe:' + write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!' + write(*,*)' -> STOP' + write(*,*) + STOP + ! alternativ koennte man hier vielleicht auch nach x=xmax zurueckrechnen + endif + +999 continue + + if (returnCode_EFeld.EQ.1) then ! Testort hinter der Mappe + dt = 0.5*dt + found_lower = .false. + found_upper = .false. + goto 10 + elseif (returnCode_EFeld.EQ.2) then ! Testort neben der Mappe + destiny = code_wand + elseif (returnCode_EFeld.EQ.3) then ! Testort vor der Mappe + if (v(1).LE.0) then ! reflektiert -> kann vorkommen + destiny = code_reflektiert + else ! in Vorwaertsbewegung -> darf nicht vorkommen!! + write(*,*) + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) + write(*,*)' Test-x liegt vor der Mappe!' + write(*,*)' x,y,z = ',x + write(*,*)' Teilchen-Nr = ',Start_Nr(1) + write(*,*)' xEnterMap_M2 = ',xEnterMap + write(*,*)' xEnterMap_M2 - x(1) = ',xEnterMap - x(1) + write(*,*) + write(*,*)' -> STOP' + write(*,*) + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_M2(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_M2/ 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_M2(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_M2(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_M2(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_M2(x,E,*) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_M2.INC' + + real real_i,real_j ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real radius ! Betrag des Radiusvektors in y-z-Ebene + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + real Erad ! radiale Feldstaerke + + +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 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Rechne in Gittereinheiten um: + + radius = sqrt(x(2)*x(2)+x(3)*x(3)) + + real_i = (x(1) - xEnterMap) / Dx + real_j = radius / Dr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Mache die Tests und berechne die Feldstaerke: + +c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt: + + if (real_j.GT.jmax) then + returnCode_EFeld = 2 + RETURN 1 + elseif (real_i.GT.real(imax)) then + if (real_i.GT.real(imax)+.5) then + returnCode_EFeld = 1 + RETURN 1 + else + real_i = imax + endif + elseif (real_i.LT.0.) then + returnCode_EFeld = 3 + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN 1 +c else +c returnCode_EFeld = 0 + endif + + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c +c Potentialverlauf ist symmetrisch zu j=0 (Linsenachse): +c +c map(i,-j) == map(i,j). +c +c Entlang j=0 ist also Erad=0 und damit E(2)=0 und E(3)=0. +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = map(ihelp-1) - map(ihelp) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1)) + E(1) = E(1) / Dx ! Reskalierung entsprechend x-Gitterkonstanten + + +c Berechne die radiale Komponente der Feldstaerke: + + if (real_j.LT.1e-10) then + E(2) = 0. + E(3) = 0. + RETURN + endif + + j = stuetzstelle_j(1) + + do n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = map(ihelp-(imax+1)) - map(ihelp) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + Erad = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + Erad = Erad / Dr ! Reskalierung entsprechend r-Gitterkonstanten + + +c Berechne E(2) und E(3) aus Erad: + + E(2) = Erad * x(2) / radius + E(3) = Erad * x(3) / radius + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_INTEGR_SP.FOR b/mutrack/src/SUB_INTEGR_SP.FOR new file mode 100644 index 0000000..c4abfbb --- /dev/null +++ b/mutrack/src/SUB_INTEGR_SP.FOR @@ -0,0 +1,1112 @@ +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_SP_1 +c ========================= + + IMPLICIT NONE + + character*4 Nr + parameter (Nr='Sp_1') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_1.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + namelist /geometry/ xSpGrid1,xSpGrid2,dWires_Sp + + namelist /grid_info/ + + Dx,Dy, imax,jmax, xmin,xmax,ymax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'_1.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + rewind (lunREAD) + read (lunREAD,nml=geometry) + close (lunREAD) + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c die geometrischen Daten fuer MUTRACK zusammenstellen: + + dSpiegel = xSpGrid2 - xSpGrid1 + dist_Wires_Sp = 2. * real(jmax) * Dy + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_SP_2 +c ========================= + + IMPLICIT NONE + + character*4 Nr + parameter (Nr='Sp_2') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_2.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + namelist /grid_info/ + + Dx,Dy, imax,jmax, xmin,xmax,ymax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'_2.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + close (lunREAD) + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_INFO_SP_3 +c ========================= + + IMPLICIT NONE + + character*4 Nr + parameter (Nr='Sp_3') + + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_3.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + namelist /grid_info/ + + Dx,Dy, imax,jmax, xmin,xmax,ymax + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + logical map_error + COMMON /map_error/ map_error + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Einlesen der Mappen-Informationen: + + open (lunREAD,file=mappenName//'_3.INFO',defaultfile=mappenDir, + + readonly,status='old') + read (lunREAD,nml=grid_info) + close (lunREAD) + + +c eingelesene imax und jmax um 1 reduzieren, da in 'MUTRACK' die Feldindizes +c ab 0 laufen, bei 'RELAX3D' jedoch ab 1: + + imax = imax-1 + jmax = jmax-1 + + +c checken, ob der reservierte Speicherplatz ausreicht: + + if ((imax+1)*(jmax+1).NE.maxmem+1) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + write(*,*) Nr//'-Mappe: ',mappenName + write(*,*) ' BENOETIGTER Speicher: (imax+1)*(jmax+1) = ',(imax+1)*(jmax+1) + write(*,*) ' RESERVIERTER Speicher: maxmem + 1 = ',maxmem + 1 + write(*,*) + if ((imax+1)*(jmax+1).GT.maxmem+1) then + write(*,*) '=> reservierter Speicherplatz ist ungenuegend.' + write(*,*) + write(*,*) '=> ''maxmem'' in mutrack$sourcedirectory:MAP_DEF_'//Nr//'.INC angleichen,' + write(*,*) ' dann Programm mit ''LINKMUV'' am DCL-Prompt neu kompilieren' + write(*,*) ' und linken.' + write(*,*) + write(*,*) ' Mindestwert fuer ''maxmem'' ist ',(imax+1)*(jmax+1)-1 + write(*,*) + map_error = .true. + endif + endif + + if (map_error) then + write(*,*)'----------------------------------------'// + + '----------------------------------------' + STOP + endif + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_SP_1 +c ======================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='_1') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_1.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP_SP.INC' + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_SP_2 +c ======================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='_2') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_2.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP_SP.INC' + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_MAP_SP_3 +c ======================== + + IMPLICIT NONE + + character*(*) Nr + parameter (Nr='_3') + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_3.INC' + INCLUDE 'mutrack$sourcedirectory:READ_MAP_SP.INC' + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_SP(dt) +c ============================================== + + IMPLICIT NONE + SAVE + + character*(*) Nr + parameter (Nr='Sp') + +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 'MUTRACK.FOR') + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + character*40 MappenName + real dl_max + COMMON /integration_Sp/ MappenName,dl_max + + 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 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 bei dt < dtsmall der Fehler + ! immer noch zu gross ist. + + 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 + 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_SP(x,EFeld0,*999) + +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_SP(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_SP(x1,EFeld1,*999) + + +c mache zweiten dt/2 - Schritt: + + call SINGLESTEP_RUNGE_KUTTA_SP(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_SP(dt,EFeld0,x,v, Dx2,Dv2 ,*999) + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c Fehlerbetrachtung und Berechnung des endgueltigen Ergebnisses: + +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 Geschwindikeit (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) + + + maxErr = Max(maxErr_x,maxErr_v) + + if (maxErr.GT.1.) then + 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 + + +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) + Dx1(1) + xDifferenz(1) / 15. + 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 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: +d if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))) + endif + + RETURN + + +c hier folgt der Code fuer 'returnCode_EFeld.NE.0': + +999 continue + + if (returnCode_EFeld.EQ.1) then ! Testort hinter der Mappe + destiny = code_durchSpiegel + RETURN + 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 + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SINGLESTEP_RUNGE_KUTTA_SP(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'. Die Formeln sind zwar teilweise +c etwas umgeschrieben, sind aber mathematisch alle aequivalent zu denen der +c Referenz. + +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_SP/ 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_SP(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_SP(xTest,E2,*999) + + do i = 1, 3 + xTest(i) = x0(i) + v2(i) * dt + v3(i) = v0(i) + E2(i) * help + enddo + call EFeld_SP(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_SP(x,E,*) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + real x(3),E(3) ! Ort und Feldstaerke + +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 + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Pruefe, in welchen Mappenbereich der Raumpunkt faellt und rufe entsprechende +c Routine auf: +c Mappe 1 ist die groebste, Mappe 2 etwas feiner, Mappe 3 ist die feinste. + + + if (x(1).LT.0) then + E(1) = 0. + E(2) = 0. + E(3) = 0. + RETURN + elseif (x(1).GT.xmax_Sp_1) then + returnCode_Efeld = 1 + RETURN 1 + elseif (x(1).LT.xmin_Sp_2.OR.x(1).GT.xmax_Sp_2) then + CALL EFeld_Sp_1(x,E) + elseif (x(1).LT.xmin_Sp_3.OR.x(1).GT.xmax_Sp_3) then + CALL EFeld_Sp_2(x,E) + else + CALL EFeld_Sp_3(x,E) + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE EFeld_SP_1(x,E) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_1.INC' + + real real_i,real_j,real_j_ ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + + integer zaehler_Sp_1 /0/ + common /zaehler_Sp_1/ zaehler_Sp_1 +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + zaehler_Sp_1 = zaehler_Sp_1 + 1 + +c Rechne in Gittereinheiten um und teste, ob Raumpunkt innerhalb der Potential- +c mappe liegt: + + real_i = (x(1)-xmin)/Dx ! Umrechnung in Mappensystem findet bereits in + real_j_ = x(2)/ Dy ! MUTRACK statt. + +c Mappe ist zyklisch in y-Richtung. j laeuft von 0 bis jmax vom 0. Gitterstab +c zur Mitte zwischen 0. und 1. Gitterstab. +c -> 1.) waehle aequivalentes real_j aus Bereich von Mitte zwischen -1. und 0. +c Gitterstab bis Mitte zwischen 0. und 1. Gitterstab. +c 2.) Nimm Absolutbetrag. + + n = nInt(real_j_/(2.*real(jmax))) + real_j_ = real_j_ - real(n) * (2.*real(jmax)) + real_j = abs(real_j_) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Berechne die Feldstaerke: + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + if (real_i.GT.real(imax)) then +c if (real_i.GT.real(imax)+.5) then + write(*,*)'Sub_integr_SP_1: Fehlermarke 0' + STOP +c else +c real_i = imax +c endif + endif + + if (stuetzstelle_j(1).EQ.jmax .AND. Abstand_j.GT.0.) then + write(*,*)'Sub_integr_SP_1: Fehlermarke 1' + write(*,*)'xmin,xmax,ymax = ',xmin,xmax,ymax + write(*,*)'x = ',x + write(*,*)'real_j, stuetzstelle_j,abstand_j = ',real_j, stuetzstelle_j,abstand_j + STOP + elseif (stuetzstelle_j(1).EQ.0 .AND. Abstand_j.LT.0.) then + write(*,*)'Sub_integr_SP_1: Fehlermarke 2' + write(*,*)'xmin,xmax,ymax = ',xmin,xmax,ymax + write(*,*)'x = ',x + write(*,*)'real_j, stuetzstelle_j,abstand_j = ',real_j, stuetzstelle_j,abstand_j + STOP + endif + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = map(ihelp-1) - map(ihelp) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_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 n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp-(imax+1))) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + E(2) = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + + E(2) = E(2) / Dy ! Reskalierung entsprechend y-Gitterkonstanten + if (real_j_.LT.0) E(2) = -E(2) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE EFeld_SP_2(x,E) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_2.INC' + + real real_i,real_j,real_j_ ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + + integer zaehler_Sp_2 /0/ + common /zaehler_Sp_2/ zaehler_Sp_2 +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + zaehler_Sp_2 = zaehler_Sp_2 + 1 + +c Rechne in Gittereinheiten um und teste, ob Raumpunkt innerhalb der Potential- +c mappe liegt: + + real_i = (x(1)-xmin)/Dx ! Umrechnung in Mappensystem findet bereits in + real_j_ = x(2)/ Dy ! MUTRACK statt. + +c Mappe ist zyklisch in y-Richtung. j laeuft von 0 bis jmax vom 0. Gitterstab +c zur Mitte zwischen 0. und 1. Gitterstab. +c -> 1.) waehle aequivalentes real_j aus Bereich von Mitte zwischen -1. und 0. +c Gitterstab bis Mitte zwischen 0. und 1. Gitterstab. +c 2.) Nimm Absolutbetrag. + + n = nInt(real_j_/(2.*real(jmax))) + real_j_ = real_j_ - real(n) * (2.*real(jmax)) + real_j = abs(real_j_) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Berechne die Feldstaerke: + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + if (real_i.GT.real(imax)) then +c if (real_i.GT.real(imax)+.5) then + write(*,*)'Sub_integr_SP_2: Fehlermarke 0' + STOP +c else +c real_i = imax +c endif + endif + + if (stuetzstelle_j(1).EQ.jmax .AND. Abstand_j.GT.0.) then + write(*,*)'Sub_integr_SP_2: Fehlermarke 1' + write(*,*)'xmin,xmax,ymax = ',xmin,xmax,ymax + write(*,*)'x = ',x + write(*,*)'real_j, stuetzstelle_j,abstand_j = ',real_j, stuetzstelle_j,abstand_j + STOP + elseif (stuetzstelle_j(1).EQ.0 .AND. Abstand_j.LT.0.) then + write(*,*)'Sub_integr_SP_2: Fehlermarke 2' + write(*,*)'xmin,xmax,ymax = ',xmin,xmax,ymax + write(*,*)'x = ',x + write(*,*)'real_j, stuetzstelle_j,abstand_j = ',real_j, stuetzstelle_j,abstand_j + STOP + endif + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = map(ihelp-1) - map(ihelp) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_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 n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp-(imax+1))) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + E(2) = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + + E(2) = E(2) / Dy ! Reskalierung entsprechend y-Gitterkonstanten + if (real_j_.LT.0) E(2) = -E(2) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE EFeld_SP_3(x,E) +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:MAP_DEF_SP_3.INC' + + real real_i,real_j,real_j_ ! x,r im Mappensystem in Gittereinheiten + + integer stuetzstelle_i(2) ! naechste Stuetzstellen in x- und + integer stuetzstelle_j(2) ! r-Richtung + + real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle + real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!) + + integer i,j, n, ihelp + + real x(3),E(3) ! Ort und Feldstaerke + real E_(2) ! Hilfsspeicher fuer Feldberechnung + + integer zaehler_Sp_3 /0/ + common /zaehler_Sp_3/ zaehler_Sp_3 +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + zaehler_sp_3 = zaehler_sp_3 + 1 + +c Rechne in Gittereinheiten um und teste, ob Raumpunkt innerhalb der Potential- +c mappe liegt: + + real_i = (x(1)-xmin)/Dx ! Umrechnung in Mappensystem findet bereits in + real_j_ = x(2)/ Dy ! MUTRACK statt. + +c Mappe ist zyklisch in y-Richtung. j laeuft von 0 bis jmax vom 0. Gitterstab +c zur Mitte zwischen 0. und 1. Gitterstab. +c -> 1.) waehle aequivalentes real_j aus Bereich von Mitte zwischen -1. und 0. +c Gitterstab bis Mitte zwischen 0. und 1. Gitterstab. +c 2.) Nimm Absolutbetrag. + + n = nInt(real_j_/(2.*real(jmax))) + real_j_ = real_j_ - real(n) * (2.*real(jmax)) + real_j = abs(real_j_) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Berechne die Feldstaerke: + +c Bestimme naechstgelegene Stuetzstellen und die Komponenten des Abstands- +c Gittervektors zur allernaechsten Stuetzstelle 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 + + if (real_i.GT.real(imax)) then +c if (real_i.GT.real(imax)+.5) then + write(*,*)'Sub_integr_SP_3: Fehlermarke 0' + STOP +c else +c real_i = imax +c endif + endif + + if (stuetzstelle_j(1).EQ.jmax .AND. Abstand_j.GT.0.) then + write(*,*)'Sub_integr_SP_3: Fehlermarke 1' + write(*,*)'xmin,xmax,ymax = ',xmin,xmax,ymax + write(*,*)'x = ',x + write(*,*)'real_j, stuetzstelle_j,abstand_j = ',real_j, stuetzstelle_j,abstand_j + STOP + elseif (stuetzstelle_j(1).EQ.0 .AND. Abstand_j.LT.0.) then + write(*,*)'Sub_integr_SP_3: Fehlermarke 2' + write(*,*)'xmin,xmax,ymax = ',xmin,xmax,ymax + write(*,*)'x = ',x + write(*,*)'real_j, stuetzstelle_j,abstand_j = ',real_j, stuetzstelle_j,abstand_j + STOP + endif + + +c............................................................................... +c Berechnen des elektrischen Feldes: +c ---------------------------------- +c............................................................................... + +c Berechne die x-Komponente der Feldstaerke: + +c Um die Feldstaerke zu bekommen, interpoliere jeweils linear zwischen den +c Werten auf den beiden naechstgelegenen j-Ketten: + + i = stuetzstelle_i(1) + + do n = 1, 2 + j = stuetzstelle_j(n) + ihelp = j*(imax+1) + i + if (i.EQ.imax) then + E_(n) = map(ihelp-1) - map(ihelp) + elseif (i.GT.0) then + E_(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1)) + + + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1)) + else + E_(n) = map(ihelp) - map(ihelp+1) + endif + enddo + E(1) = E_(1) + Abstand_j_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 n = 1, 2 + i = stuetzstelle_i(n) + ihelp = j*(imax+1) + i + if (j.EQ.jmax) then + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp-(imax+1))) + elseif (j.GT.0) then + 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) = map(i,j+1) == map(i,1) + E_(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1))) + endif + enddo + E(2) = E_(1) + Abstand_i_Betrag*(E_(2)-E_(1)) + + E(2) = E(2) / Dy ! Reskalierung entsprechend y-Gitterkonstanten + if (real_j_.LT.0) E(2) = -E(2) + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_OUTPUT.FOR b/mutrack/src/SUB_OUTPUT.FOR new file mode 100644 index 0000000..592350b --- /dev/null +++ b/mutrack/src/SUB_OUTPUT.FOR @@ -0,0 +1,2874 @@ + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE INITIALIZE_OUTPUT +c ============================ + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + + integer i, l, k, iostat, zaehler /0/, par_ + logical flag /.false./ + integer fileNr + integer fileNrReal /0/, fileNrTest /9900/ ! laufende Nummern der + ! Ausgabe-files + + character antwort*5,zeile*80 + + character*80 varNames,loopZeile,parValues + COMMON /zeilen/ varNames,loopZeile,parValues + + character*80 strichU,strich1,strich2 + parameter(strichU = '________________________________________'// + + '________________________________________', + + strich1 = '----------------------------------------'// + + '----------------------------------------', + + strich2 = '========================================'// + + '========================================') + + integer DimZeilenVek + parameter (DimZeilenVek = 15) + integer PHYSICA_ZeilenVektor(DimZeilenVek) + + integer NumHeaderLines,NumMarkedLines,lineNrArtList + + integer statDefsPerRec + parameter (statDefsPerRec = Int((4*LwPerRec)/(LengthStatName+4)) ) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c falls Bildschirmausgabe verlangt ist, erstmal etwas Abstand schaffen: + + write(*,*) + if (n_outWhere.GE.2) then + do k = 1, 5 + write(*,*) + enddo + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (.NOT.gotFileNr) then + +c den Namen der Ausgabe-files definieren: + + if (LogFile.OR.smallLogFile.OR.input_list) then + open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir, + + status='OLD',iostat=iostat) + if (iostat.EQ.0) then + read(lunREAD,*) fileNrReal,fileNrTest! die aktuelle Dateinummer einlesen + close(lunREAD) + endif + if (TestRun) then + fileNr = fileNrTest + 1 + if (fileNr.EQ.10000) fileNr = 9900 + else + fileNr = fileNrReal + 1 + endif + write(filename(4:7),'(I4)')fileNr + if (fileNr.LE.999) write (filename(4:4),'(A1)') '0' + if (fileNr.LE. 99) write (filename(5:5),'(A1)') '0' + if (fileNr.LE. 9) write (filename(6:6),'(A1)') '0' + + if (input_list) then + ! Ausgabe der (negativen) fileNr in die 'inputListe': + open(lunRead,file=inputListName//'.INPUT',status='old',iostat=iostat, + + defaultfile=readDir) + if (iostat.NE.0) then + write(*,*) ' Kann '''//inputListName//'.INPUT'' nicht oeffnen' + write(*,*) + call exit + endif + do k = 1,ListLength + read(lunRead,*) + enddo + read(lunRead,*) k ! Nummer des aktuell bearbeitete files + write(lunRead,*) -fileNr + close(lunRead) + + if (TestRun) then ! + fileNrTest = fileNrTest+k ! reserviere k Nummern fuer die + else ! k noch ausstehenden Eingabe- + fileNrReal = fileNrReal+k ! files der input_liste! + endif + open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir, + + status='OLD',iostat=iostat) + if (iostat.NE.0) then + write(*,*) ' ================================================' + write(*,*) ' create file '//NrDir//':MUTRACK_NR.DAT' + write(*,*) ' ================================================' + open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir, + + status='NEW') + endif + write(lunREAD,*) fileNrReal,fileNrTest + write(lunREAD,*) 'Diese Datei enthaelt die zuletzt'// + + ' vergebene Nummer ''nnnn'' fuer die' + write(lunREAD,*) 'Ausgabedateien ''MU_nnnn'' des Programms'// + + ' MUTRACK (separat fuer RealRuns' + write(lunREAD,*) 'und TestRuns).' + close(lunREAD) + + endif + + else + fileName = ' ' + endif + + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Header zusammen stellen: + + call Make_HeaderFile + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Header auf Schirm ausgeben und abfragen, ob Einstellungen in Ordnung sind: + + write(*,*) strich2 + + NumHeaderLines = 0 + NumMarkedLines = 0 + rewind(lunTMP) +997 read (lunTMP,'(A)',END=998) zeile + write (*,'(x,A)') zeile + + ! gleich noch pruefen, welche Zeilen vom PHYSICA-Macro 'MULOG.PCM' + ! eingelesen werden sollen: + + if (createPhysTab) then + + NumHeaderLines = NumHeaderLines + 1 ! zaehle mit, wie viele + ! Headerzeilen es gibt + + if (zeile(1:10).EQ.'Projektile' .AND. artList_defined) then + LineNrArtList = NumHeaderLines + endif + + if (.NOT.flag) then + if (index(zeile,'eps_x').NE.0) then + flag = .true. ! damit nicht zufaellig Kommentarzeilen + ! ausgewaehlt werden + elseif (zeile(1:10).EQ.'Projektile' + + .OR. index(zeile,'Trigger').NE.0 + + .OR. zeile(1:13).EQ.'neutral Fract' + + .OR. zeile(1:5 ).EQ.'Start' +c + .OR. zeile(1:16).EQ.'- Energieverlust' +c + .OR. zeile(1:13).EQ.'- Foliendicke' + + .OR. (zeile(1:2).EQ.'- '.AND.index(zeile,'iMonitor').EQ.0 + + .AND. index(zeile,'Schnitt').EQ.0 .AND. index(zeile,'- - - -').EQ.0 ) + + .OR. index(zeile,'Draht').NE.0 + + .OR. index(zeile,'zerfall').NE.0 + + .OR. index(zeile,'EALER').NE.0 + + ) then + if (NumMarkedLines.LT.DimZeilenVek) then + NumMarkedLines = NumMarkedLines + 1 + PHYSICA_ZeilenVektor(NumMarkedLines) = NumHeaderLines + else + zaehler = zaehler + 1 + endif + + endif + endif + endif + goto 997 + +998 if (zaehler.NE.0) then + write(*,*)'DIMENSION VON ''PHYSICA_ZEILENVEKTOR'' IST ZU GERING' + write(*,'(x,I1,A)') zaehler,' Zeilen konnten nicht aufgenommen werden' + endif + + if (.NOT.BATCH_MODE) then + write(*,1010) + read(*,1011) antwort +1010 format(T27,'ok? ( = ABBRUCH) -> ',$) +1011 format(A5) ! bis zu vier Leerzeichen vor Buchstaben werden akzeptiert + + k = 0 +1 k = k+1 + if (antwort(k:k).eq.' ' .AND. k.LE.4) then + goto 1 + elseif (antwort(k:k).eq.'n' .or. antwort(k:k).eq.'N' .or. + + antwort(k:k).eq.'a' .or. antwort(k:k).eq.'A' .or. + + antwort(k:k).eq.'c' .or. antwort(k:k).eq.'C' ) then + close(lunTMP) + write(*,'(A)') strich2 + write(*,*) + STOP + endif + if (OneLoop) write(*,'(A)') strich2 + endif + + if ((LogFile.OR.smallLogFile) .AND. .NOT.input_list) then + if (TestRun) then + fileNrTest = fileNr + else + fileNrReal = fileNr + endif + open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir, + + status='OLD',iostat=iostat) + if (iostat.NE.0) then + write(*,*) ' ================================================' + write(*,*) ' create file '//NrDir//'MUTRACK_NR.DAT' + write(*,*) ' ================================================' + open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir, + + status='NEW') + endif + write(lunREAD,*) fileNrReal,fileNrTest + write(lunREAD,*) 'Diese Datei enthaelt die zuletzt'// + + ' vergebene Nummer ''nnnn'' fuer die' + write(lunREAD,*) 'Ausgabedateien ''MU_nnnn'' des Programms'// + + ' MUTRACK (separat fuer RealRuns' + write(lunREAD,*) 'und TestRuns).' + close(lunREAD) + endif + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c falls gewuenscht: Ausgabe-Datei .LOG oeffnen und Header schreiben: + + if (smallLogFile.OR.createTabellen) call Make_VarNames + + if (LogFile .OR. smallLogFile) then + open(lun(1),file=filename//'.LOG', + + defaultfile=outDir, + + status='NEW',carriagecontrol='LIST') + + rewind(lunTMP) +995 read (lunTMP,'(A)',END=996) zeile + write (lun(1),'(A)') zeile + goto 995 + +996 if (smallLogFile) then + write(lun(1),*) + write(lun(1),'(A)') varNames + write(lun(1),'(A)') strich1 + endif + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c die Ausgabe-files fuer die Tabellen initialisieren: + + if (createTabellen) then + do l= 1, stat_Anzahl + if (createTabelle(l)) then + open(lunPHYSICA+l,file=filename//TabExt(l), + + defaultfile=outDir, + + carriagecontrol='LIST',status='NEW') + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,'(T35,A)') statName(l) + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,*) + write(lunPHYSICA+l,'(A)') strich2 + + rewind(lunTMP) +993 read (lunTMP,'(A)',END=994) zeile + write (lunPHYSICA+l,'(A)') zeile + goto 993 + +994 write(lunPHYSICA+l,*) + write(lunPHYSICA+l,'(A)') varNames + write(lunPHYSICA+l,'(A)') '_Nr_________mean____'// + + 'Varianz_____________von_______bis___________Anzahl______%___' + write(lunPHYSICA+l,*) + endif + enddo + endif + + +c das temporaere Header file schliessen: + + close(lunTMP) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Ausgabefile 'MU_nnnn.PHYSICA' oeffnen und initialisieren: +c --------------------------------------------------------- +c +c Struktur des Headers: +c +c 1. Record: 'VERSION'//VersionsNummer +c +c 2. Record: par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY,StartsProSchleife, +c CodeMasse,CodeLadung,LineNrArtList, numHeaderLines,NumMarkedLines, +c lengthParName,lengthStatName +c +c Anschliessend eine Auflistung der Nummern derjenigen Zeilen aus dem Header +c von 'MU_nnnn.LOG', welche innerhalb von PHYSICA mittels 'MUPARG' und 'MUPART' +c ausgegeben werden sollen ('PHYSICA_Zeilenvektor'). Die Zeilennummern werden +c hintereinander in ein Record geschrieben. Ist dieses voll, so wird das +c naechste Record begonnen. +c +c Es folgt eine Auflistung der in die Simulation eingehenden Schleifenparameter. +c Jeder Parameter erhaelt ein eigenes Record. In dieses wird die Nummer des +c Parameters, die Anzahl der angenommenen Werte, der Minimalwert, der Maximal- +c wert, die sich daraus ergebende Schrittweite und die Benennung des Parameters +c ausgegeben. +c +c Naechster Punkt ist eine Liste der in das .PHYSICA file aufgenommenen Statisti- +c ken (jeweils Codenummer und Benennung). Es werden jeweils so viele Statistik- +c beschreibungen in ein Record geschrieben wie ganzzahlig hineinpassen. +c +c Zum Schluss folgt die Auflistung der in dem .PHYSICA file enthaltenen 'whats' +c (Auswahl aus 'mean', 'variance', 'minimum', 'maximum' und 'percent'). Hier +c werden nur die jeweiligen Codenummern hintereinander in ein Record geschrie- +c ben. +c +c Die sich hiermit ergebende Gesamtlaenge des Headers summiert sich zu +c +c NrOfInfoLines = 1 ! <- Version +c + 1 ! <- allg. Groessen +c + int((NumMarkedLines-1)/LwPerRec) + 1 ! <- 'Zeilenvektor' +c + par_Anzahl ! <- Parameter +c + int((stat_Anzahl-1)/statDefsPerRec) + 1 ! <- Statisiken +c + 1 ! <- 'WhatList' +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (createPhysTab) then + + open(lunPHYSICA,file=fileName//'.PHYSICA',defaultfile=outDir, + + form='unformatted',recordtype='fixed',recl=LwPerRec,status='NEW') + + write(lunPHYSICA) 'VERSION',version + + ! Berechne Anzahl der in die Simulation eingehenden Parameter: + par_Anzahl_used = 0 + do i = 1, par_Anzahl + par_ = reihenfolge(i) + if (n_par(par_).NE.0) then + par_Anzahl_used = par_Anzahl_used + 1 + parList(par_Anzahl_used) = par_ + endif + enddo + + ! Berechne Anzahl der in das Physica-file ausgegebenen Statistiken: + statAnzahlPHY = 0 + do k = 1, stat_Anzahl + if (statInPHYSICA(k)) then + statAnzahlPHY = statAnzahlPHY + 1 + statList(statAnzahlPHY) = k + endif + enddo + + ! Berechne Anzahl der verlangten statistischen Groessen: + whatAnzahlPHY = 0 + do k = 1, what_Anzahl + if (whatInPHYSICA(k)) then + whatAnzahlPHY = whatAnzahlPHY + 1 + whatList(whatAnzahlPHY) = k + endif + enddo + + write(lunPHYSICA) par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY, + + n_par(0), mass,charge,LineNrArtList, + + numHeaderLines,NumMarkedLines, lengthParName,lengthStatName + + ! Schreibe Liste der 'markierten' Zeilen: + k = 0 + do while (k.LT.NumMarkedLines) + l = min(NumMarkedLines,k+LwPerRec) + write(lunPHYSICA) (PHYSICA_ZeilenVektor(i), i=k+1,l) + k = k + LwPerRec + enddo + + ! Schreibe Liste der in die Simulation eingehenden Parameter: + do k=1,par_Anzahl_used + par_ = parList(k) + write(lunPHYSICA) par_, n_par(par_), + + par(1,par_),par(2,par_),par(3,par_),par_text(par_)(1:LengthParName) + enddo + + ! Schreibe Liste der verlangten Statistiken: + k = 0 + do while (k.LT.statAnzahlPHY) + l = min(StatAnzahlPHY,k+statDefsPerRec) + write(lunPHYSICA) (statList(i),statName(statList(i)), i=k+1,l) + k = k + statDefsPerRec + enddo + + ! Schreibe Liste der verlangten statistischen Groessen: + write(lunPHYSICA) (whatList(i), i=1,whatAnzahlPHY) + + endif + + +c Schreiben des .GEO-files: + + if (write_geo) call write_geo_file + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_HeaderFile +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + integer i,k,par_,pos + logical flag + + character datum*9,uhrzeit*8,helpChar*1 + + character*40 inputName + COMMON /inputName/ inputName + + character*80 zeile,strichU,strich1,strich2 + parameter(strichU = '________________________________________'// + + '________________________________________', + + strich1 = '----------------------------------------'// + + '----------------------------------------', + + strich2 = '========================================'// + + '========================================') + + +c Oeffnen des files zur Zwischenspeicherung der Headerzeilen: + + open (lunTMP,File='HEADER.TMP',form='FORMATTED',defaultfile=TMPDir, + + status='NEW',carriagecontrol ='NONE') +c + status='UNKNOWN',carriagecontrol ='NONE') +c "STATUS='UNKNOWN'" entfernt, um Absturz bei gleichzeitigem Zugriff mehrere +c MUTRACK-Programme auszuschliessen +c + status='SCRATCH',carriagecontrol ='NONE') +c "STATUS='SCRATCH'" entfernt, damit .MESSAGE-Datei von "SUB_LIST.COM" die +c Nummer des zuletzt abgearbeiteten INPUT-Files gelesen werden kann. + + +c I.: allgemeine Settings: +c ------------------------ + + call date(datum) + call time(uhrzeit) + + write(lunTMP,11) filename,version,datum,uhrzeit +11 format(A,T19,'> VERSION 'A' <',T48,'begonnen am ',A,' um ',A) + + +c Einheiten: +c ---------- + + write(lunTMP,'(A)') 'UNITS: Spannung:kV, Winkel:deg, '// + + 'Masse:keV/c**2, Ladung:e, Energie:keV, Laenge:mm' + write(lunTMP,'(A)') ' Zeiten:ns, Geschwindigkeiten:mm/ns' + + +c Einlesefile fuer Kammmergeometrie: +c ---------------------------------- + + write(lunTMP,'(A)') strich1 + write(lunTMP,'(A,A)') 'Geometriefile: ',geo_fileName + if (xBlende.NE.-1) then + write(lunTMP,'(A,F6.1,A,F4.1,A)') 'Blende bei ',xBlende,' (Radius ', + + radius_Blende,' mm)' + endif + + +c Schleifen-Parameter: +c -------------------- + + if (random_E0) par_text(ener)(8:10) = '(*)' + if (random_pos) then + par_text(yPos)(8:10) = '(*)' + par_text(zPos)(8:10) = '(*)' + endif + if (random_angle) then + par_text(thetAng)(8:10) = '(*)' + par_text(phiAng)(8:10) = '(*)' + endif + + write(lunTMP,'(A)') strich1 + + do par_ = 1, par_Anzahl + + if (par_.EQ.ener.AND.(ener_offset.OR.pos_offset.OR.angle_offset + + .OR..NOT.(random_E0.AND.random_pos.AND.random_angle)) .OR. + + par_.EQ.alfTgt.AND. + + ( n_par(alfTgt.NE.0).OR.n_par(alfSp.NE.0).OR.n_par(alfTD.NE.0) ) .OR. + + par_.EQ.Thickn.AND.n_par(Thickn).GT.1 .OR. + + par_.EQ.BHelm.AND.(n_par(BHelm).NE.0.OR.n_par(BTD).NE.0 ) ) then + write(lunTMP,*) + endif + + if (n_par(par_).EQ.0) then + ! unbenutzte Parameter => keine Ausgabe + elseif (par_.EQ.ener .AND. E0InterFromFile) then + if (n_par(ener).EQ.1) then + write(lunTMP,120) par_text(par_),n_par(par_) + else + write(lunTMP,120) par_text(par_),n_par(par_),n_par(par_) + endif + elseif (par_.EQ.Eloss.AND.n_par(Eloss).EQ.1) then + ! genau ein Eloss-Wert => Ausgabe mit TD-Daten => hier keine Ausgabe + elseif (par_.EQ.Thickn.AND.n_par(Thickn).EQ.1) then + ! genau ein Thickn-Wert => Ausgabe mit TD-Daten => hier keine Ausgabe + elseif (par_.EQ.charge .AND. artList_defined) then + ! keine Ausgabe + else + + if (par_.EQ.UFolie .OR. par_.EQ.UMCP2 .OR. par_.EQ.mass) then + ! falls eine dieser Groessen ins Logfile kommt: Leerzeile voraus + write(lunTMP,*) + endif + + if (n_par(par_).EQ.1) then + write(zeile,101) par_text(par_),par(1,par_) + elseif (n_par(par_).EQ.2) then + write(zeile,102) par_text(par_),par(1,par_), + + par(2,par_),n_par(par_) + else + write(zeile,103) par_text(par_),par(1,par_), + + par(2,par_),par(3,par_),n_par(par_) + endif + write(lunTMP,'(A)') zeile + + endif + enddo + +101 format(A,2X,F11.3) +102 format(A,' (',F11.3,',',F11.3,')',16X,'(',I5,' Werte)') +103 format(A,' (',F11.3,',',F11.3,',',F11.3,')',T65,'(',I5, + +' Werte)') +120 format(A,I8,' E0-Intervall',:,'e',T65,'(',I5,' Bereiche)') + + +c 'ArtList' und neutrale Anteile nach Foliendurchgang: +c ---------------------------------------------------- + + if (artList_defined) then + write(lunTMP,*) + if (n_par(charge).EQ.1.) then + write(zeile,90) artList + else + write(zeile,90) artList,INT(n_par(charge)) + endif + write(lunTMP,'(A)') Zeile + endif +90 format('Projektile : ',A,:,T65,'(',I5,' Werte)') + + if (log_neutralize) then + write(lunTMP,91) (neutral_fract(k),k=1,n_par(charge)) + endif +91 format('neutral Fract: ',10(:,F5.1,x)) + + write(lunTMP,'(A)') strich1 + + +c Zufallsstarts, Schleifen- und Gesamtzahl: +c ----------------------------------------- + + write(zeile,104) SchleifenZahl,GesamtZahl +104 format(T30,'Schleifen: ',I5,T53,'=> total:',T66,I8, + + ' Starts') + if (random_E0.OR.random_pos.OR.random_angle) then + write(zeile(1:22),105)n_par(0) + else + write(zeile(1:19),'(A)') 'keine Zufallsstarts' + endif +105 format('Zufallsstarts: ',I7) + + write(lunTMP,'(A)') zeile + + +c Zufallsverteilte Startparameter: +c -------------------------------- + +c - Energie: + + if (random_E0) then + + if (random_E0_equal) then + if (E0InterFromFile) then + write(zeile, 30) n_par(ener),lowerE0,upperE0 + else + write(zeile, 31) lowerE0,upperE0 + endif +30 format('Startenergie : ',I3,' gleichverteilte Bereiche zwischen ',F6.3,' und ',F6.3) +31 format('Startenergie : gleichverteilt zwischen ',F6.3,' und ',F6.3) + + elseif (random_E0_Gauss) then + write(zeile, 32) sigmaE0 +32 format('Startenergie : gaussverteilt (sigma = ',F6.3,')') + + endif + if (ener_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70) + write(lunTMP,'(A)') Zeile + endif + +c - Winkel: + + if (random_angle) then + + if (random_lambert) then + write(zeile, 51) StartLambertOrd +51 format('Startwinkel : lambertverteilt (Ordnung: ',F6.2,')') + + elseif (random_gauss) then + write(zeile, 52) SigmaWinkel +52 format('Startwinkel : gaussverteilt (sigma = ',F5.3')') + + endif + if (angle_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70) + write(lunTMP,'(A)') Zeile + endif + +c - Position: + + if (random_pos) then + + if (random_y0z0_equal) then + write(zeile, 41) StartBreite,StartHoehe +41 format('Startposition: gleichverteilt auf Viereck mit ' + + 'dy*dz = ',F5.2,'*',F5.2) + + elseif (random_r0_equal) then + write(zeile, 42) StartRadius +42 format('Startposition: gleichverteilt auf Kreis mit ' + + 'r = ',F5.2) + + elseif (random_y0z0_Gauss) then + write(zeile, 43) sigmaPosition,StartBreite,StartHoehe +43 format('Startposition: gaussverteilt (sigma = 'F5.2,') auf ', + + 'Viereck mit dy*dz = ',F5.2,'*',F5.2) + + elseif (random_r0_Gauss) then + write(zeile, 44) sigmaPosition,StartRadius +44 format('Startposition: gaussverteilt (sigma = 'F5.2,') auf ', + + 'Kreis mit r = ',F5.2) + + endif + if (pos_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70) + write(lunTMP,'(A)') Zeile + endif + + +c Startflaeche: +c ------------- + + if (Startflaeche.EQ.-1) then + write(zeile,53) Gebiet_Text(Gebiet0) +53 format('Startflaeche : Gebiet = ''',A) + pos = 80 + do while (zeile(pos:pos).NE.':') + pos = pos - 1 + enddo + write(zeile(pos:pos+14),54) x0(1) +54 format(''', x0 = ',F7.2) + write(lunTMP,'(A)') zeile + elseif (Startflaeche.EQ.1) then + write(lunTMP,'(A)') 'Startflaeche : 1. Gitter' + elseif (Startflaeche.EQ.2) then + write(lunTMP,'(A)') 'Startflaeche : TD-Folie (Startwinkel '// + + 'im Kammersystem)' + elseif (Startflaeche.EQ.3) then + write(lunTMP,'(A)') 'Startflaeche : TD-Folie (Startwinkel '// + + 'im Triggersystem)' + else + write(lunTMP,'(A)') 'Startflaeche : Moderator' + endif + + write(lunTMP,'(A)') strich2 + + +c reale und ideale Feldberechnungen: +c ---------------------------------- + + if (Use_ACCEL) then + i = index(fileName_ACCEL,' ') + k = index(accelVersion,' ') + if (k.EQ.0) k=9 + zeile = 'REALER Beschleuniger ('//fileName_ACCEL(1:i-1)// + + ', ACCEL-Version '//accelVersion(1:k-1)//'), ' + pos = 40+i+k + elseif (Gebiet0.LE.upToHeShield) then + zeile = 'IDEALER Beschleuniger, ' + pos = 24 + else + pos = 1 + endif + + + if (idealMirror) then + zeile(pos:pos+14) = 'IDEALER Spiegel' + pos = pos + 15 + else + zeile(pos:pos+13) = 'REALER Spiegel' + pos = pos + 14 + endif + + write(lunTMP,'(A)') zeile + + + if (Use_ACCEL .AND. mappenNameACCEL.NE.' ') then + write(lunTMP,'(A)') 'ACCEL-MAPPE: '//mappenNameAccel + endif + + +c 'foilfile': +c ----------- + + if (Use_MUTRACK) then + i = index(fileName_MUTRACK,' ') + k = index(MUTRACKVersion,' ') + if (k.EQ.0) k=9 + zeile = 'Foilfile: '//fileName_MUTRACK(1:i-1)// + + ' (MUTRACK-Version '//MUTRACKVersion(1:k-1)//')' + write(lunTMP,'(A)') zeile + endif + + if (Use_ACCEL .AND. scaleFactor.NE.1) then + write(lunTMP,'(A,F5.2,A)') 'Beschleunigergeometrie durch Skalierung mit Faktor ',scaleFactor,' erhalten' + endif + +c Programmsteuerung: +c ------------------ + + if (createFoilFile) then + if (gridInFrontOfFoil) then + write(zeile,111) '(GITTER VOR TRIGGERFOLIE)' + else + write(zeile,111) '(kein Gitter vor Triggerfolie)' + endif + write(lunTMP,'(A)') zeile +111 format('''FoilFile'' erstellen ',A) + elseif (upToTDFoilOnly) then + write(lunTMP,'(A)') 'Integration NUR BIS TD-FOLIE' + endif + + if (TestOnWireHit) then + zeile = 'Drahttreffer: JA, ' + pos = 19 + else + zeile = 'Drahttreffer: NEIN, ' + pos = 21 + endif + + if (mu_flag) then + if (UseDecay) then + write(zeile(pos:pos+17),'(A)') 'Myonenzerfall: JA ' + if (.NOT.UseDecay_prevSim) then + if (Use_ACCEL ) write(zeile(pos+18:pos+33),'(A)') '(ACCEL war OHNE)' + if (Use_MUTRACK) write(zeile(pos+18:pos+38),'(A)') '(''FoilFile'' war OHNE)' + endif + else + write(zeile(pos:pos+19),'(A)') 'Myonenzerfall: NEIN ' + if (UseDecay_prevSim) then + if (Use_ACCEL ) write(zeile(pos+20:pos+34),'(A)') '(ACCEL war MIT)' + if (Use_MUTRACK) write(zeile(pos+20:pos+39),'(A)') '(''FoilFile'' war MIT)' + endif + endif + else + zeile(pos-2:pos-2) = ' ' + endif + + write(lunTMP,'(A)') zeile + +c Triggerdetektor: +c ---------------- + + if (.NOT.createFoilFile) then ! 1: if ~~~~~~~~~~~~ + + if (TriggerInBeam .AND. .NOT.createFoilFile) then + if (generate_FE) then + if (gridInFrontOfFoil) then + write(zeile,110) '(GITTER VOR TRIGGERFOLIE, mit FE-Starts, ' + pos = 63 + else + write(zeile,110) '(kein Gitter vor Folie, mit FE-Starts, ' + pos = 61 + endif + else + if (gridInFrontOfFoil) then + write(zeile,110) '(GITTER VOR TRIGGERFOLIE, keine FE-Starts, ' + pos = 65 + else + write(zeile,110) '(kein Gitter vor Folie, keine FE-Starts, ' + pos = 63 + endif + endif +110 format('Trigger im Strahlweg ',A) + write(zeile(pos:pos+10),'(A6,F4.1,A)') 'dx5 = ',dx5,')' + write(lunTMP,'(A)') zeile + if (.NOT.upToTDFoilOnly) then + if (TestOnWireHit) write(lunTMP,76) 100*TransTDFoil +76 format('- Stuetzgittertransmission: ',F6.2'%') + if (n_par(Thickn).EQ.1) then + write(lunTMP,70) par(1,Thickn) + endif +70 format('- Foliendicke : ',F6.3,' ug/cm**2') + ! Energieverlust in Folie: + if (log_E_Verlust) then + if (log_E_Verlust_defined) then + if (n_par(Eloss).EQ.1) then + if (log_E_Straggling_sigma) then + write(zeile, 71) par(1,eloss),sigmaE + elseif (log_E_Straggling_equal) then + write(zeile, 72) par(1,eloss),lowerE,upperE + elseif (log_E_Straggling_Lindhard) then + write(zeile, 73) par(1,eloss),'; Aufstr. gaussf. nach Lindh./Scharff' + elseif (log_E_Straggling_Yang) then + write(zeile, 73) par(1,eloss),'; Aufstr. gaussf. nach Yang' + else + write(zeile, 73) par(1,eloss),' (keine Energieaufstreuung)' + endif + else + if (log_E_Straggling_sigma) then + write(zeile, 81) 'gemaess Schleife',sigmaE + elseif (log_E_Straggling_equal) then + write(zeile, 82) 'gemaess Schleife',lowerE,upperE + elseif (log_E_Straggling_Lindhard) then + write(zeile, 83) 'gemaess Schleife','; Aufstr. gaussf. nach Lindh./Scharff' + elseif (log_E_Straggling_Yang) then + write(zeile, 83) 'gemaess Schleife','; Aufstr. gaussf. nach Yang' + else + write(zeile, 83) 'gemaess Schleife',' (keine Energieaufstreuung)' + endif + endif + write(lunTMP,'(A)') Zeile + elseif (log_E_Verlust_ICRU) then + if (log_E_Straggling_sigma) then + write(zeile, 81) 'gemaess ICRU',sigmaE + elseif (log_E_Straggling_equal) then + write(zeile, 82) 'gemaess ICRU',lowerE,upperE + elseif (log_E_Straggling_Lindhard) then + write(zeile, 83) 'gemaess ICRU','; Aufstr. gaussf. nach Lindh./Scharff' + elseif (log_E_Straggling_Yang) then + write(zeile, 83) 'gemaess ICRU','; Aufstr. gaussf. nach Yang' + else + write(zeile, 83) 'gemaess ICRU',' (keine Energieaufstreuung)' + endif + if (calculate_each) write(zeile(70:79),'(A10)') '(jedesmal)' + write(lunTMP,'(A)') Zeile + if (graphitData) then + write(lunTMP,'(A)') ' (stopping power data for graphit)' + ! THIS ONE WAS EXCLUSIVELY USED IN THE BEGINNING + else + write(lunTMP,'(A)') ' (stopping power data for amorphous carbon)' + endif + endif + + endif + +71 format('- Energieverlust: ',F6.3,:'; sigma = ',F6.3) +72 format('- Energieverlust: ',F6.3,:' + gleichvert. aus ['F6.3','F6.3']') +73 format('- Energieverlust: ',F6.3,:A) +81 format('- Energieverlust: ',A,:'; sigma = ',F6.3) +82 format('- Energieverlust: ',A,:' + gleichvert. aus ['F6.3','F6.3']') +83 format('- Energieverlust: ',A,:A) + + ! Aufstreuung in Folie: + if (log_aufstreu) then + if (log_aufstreu_fixed) then + write(zeile, 75) sigmaAufstreu + write(lunTMP,'(A)') Zeile + elseif (log_Meyer_Gauss) then + write(lunTMP,'(A)') '- Winkelaufstreuung: gemaess Meyer-Formel mit Gauss-Fkt' + elseif (log_Meyer_F_Function) then + write(lunTMP,'(A)') '- Winkelaufstreuung: gemaess Meyer-Formel mit F-Funktion' + endif + endif +75 format('- Winkelaufstreuung: sigma = ',F6.2) + + + if (.NOT.(log_E_Verlust.AND.log_aufstreu.AND.log_neutralize)) then + zeile = '- NICHT:' + pos = 10 + if (.NOT.log_E_Verlust) then + write(zeile(pos:pos+14),'(A)') 'ENERGIEVERLUST,' + pos = pos + 15 + endif + if (.NOT.log_aufstreu) then + write(zeile(pos:pos+17),'(A)') 'WINKELAUFSTREUUNG,' + pos = pos + 18 + endif + if (.NOT.log_neutralize) then + write(zeile(pos:pos+15),'(A)') 'NEUTRALISIERUNG,' + pos = pos + 16 + endif + pos = pos - 1 + write(zeile(pos:pos),'(A)')' ' + write(lunTMP,'(A)') zeile + endif + endif + + else + write(lunTMP,'(A)') 'Trigger aus Strahlweg' + endif + + endif ! if (.NOT.createFoilFile) .... ! 1: endif ~~~~~~~~~ + + +c Statistiken fuer das Summary: +c ----------------------------- + + if (statsInSummary) then + zeile = 'Statistiken:' + pos = 14 + do k = 1, stat_Anzahl + if (statInSummary(k)) then + if (pos.GE.72) then + zeile(pos:pos) = ',' + write(lunTMP,'(A)') zeile + zeile = ' ' + pos = 14 + elseif (pos.GT.14) then + zeile(pos:pos) = ',' + pos = pos + 1 + endif + do i = 1, LengthStatName + helpChar = statName(k)(i:i) + if (helpChar.NE.' ' .AND. pos.LE.80) then + zeile(pos:pos) = helpChar + pos = pos+1 + endif + enddo + endif + enddo + write(lunTMP,'(A)') zeile + endif + + +c zu erzeugende Tabellen: +c ----------------------- + + if (createTabellen) then + zeile = 'Tabellen:' + pos = 14 + do k = 1, stat_Anzahl + if (createTabelle(k)) then + if (pos.GE.72) then + zeile(pos:pos) = ',' + write(lunTMP,'(A)') zeile + zeile = ' ' + pos = 14 + elseif (pos.GT.14) then + zeile(pos:pos) = ',' + pos = pos + 1 + endif + do i = 1, LengthStatName + helpChar = statName(k)(i:i) + if (helpChar.NE.' ' .AND. pos.LE.80) then + zeile(pos:pos) = helpChar + pos = pos+1 + endif + enddo + endif + enddo + zeile(13:13) = ' ' + write(lunTMP,'(A)') zeile + endif + + +c Statistiken fuer das PHYSICA file: +c ---------------------------------- + +c if (createPhysTab) write(lunTMP,'(A)') 'PHYSICA-Tabelle erstellen' + if (createPhysTab) then + zeile = 'PHYSICA-TAB:' + pos = 14 + do k = 1, stat_Anzahl + if (statInPHYSICA(k)) then + if (pos.GE.72) then + zeile(pos:pos) = ',' + write(lunTMP,'(A)') zeile + zeile = ' ' + pos = 14 + elseif (pos.GT.14) then + zeile(pos:pos) = ',' + pos = pos + 1 + endif + do i = 1, LengthStatName + helpChar = statName(k)(i:i) + if (helpChar.NE.' ' .AND. pos.LE.80) then + zeile(pos:pos) = helpChar + pos = pos+1 + endif + enddo + endif + enddo + write(lunTMP,'(A)') zeile + + zeile = '''what'' :' + pos = 14 + do k = 1, what_Anzahl + if (whatInPHYSICA(k)) then + if (pos.GE.72) then + zeile(pos:pos) = ',' + write(lunTMP,'(A)') zeile + zeile = ' ' + pos = 14 + elseif (pos.GT.14) then + zeile(pos:pos) = ',' + pos = pos + 1 + endif + do i = 1, LengthWhatName + helpChar = whatName(k)(i:i) + if (helpChar.NE.' ' .AND. pos.LE.80) then + zeile(pos:pos) = helpChar + pos = pos+1 + endif + enddo + endif + enddo + write(lunTMP,'(A)') zeile + endif + + +c Im NTupel enthaltene Groessen: +c ------------------------------ + + if (createNTP) then + zeile = 'NTP erzeugen (' + pos = 15 + if (NTP_S1xM2) then + write(zeile(pos:pos+5),'(A)') 'S1xM2,' + pos = pos + 7 + endif + if (NTP_times) then + write(zeile(pos:pos+5),'(A)') 'times,' + pos = pos + 7 + endif + if (NTP_FoM2Only) then + write(zeile(pos:pos+4),'(A)') 'FoM2,' + pos = pos + 6 + endif + if (NTP_charge) then + write(zeile(pos:pos+6),'(A)') 'charge,' + pos = pos + 8 + endif + if (NTP_start) then + write(zeile(pos:pos+5),'(A)') 'start,' + pos = pos + 7 + endif + if (NTP_lifetime) then + write(zeile(pos:pos+8),'(A)') 'lifetime,' + pos = pos + 10 + endif + if (NTP_40mm) then + write(zeile(pos:pos+4),'(A)') '40mm,' + pos = pos + 6 + endif + if (NTP_stop) then + write(zeile(pos:pos+4),'(A)') 'stop,' + pos = pos + 6 + endif + if (NTP_Folie) then + write(zeile(pos:pos+5),'(A)') 'folie,' + pos = pos + 7 + endif + if (NTP_steps) then + write(zeile(pos:pos+5),'(A)') 'steps,' + pos = pos + 7 + endif + zeile(pos-2:pos-2) = ')' + write(lunTMP,'(A)') zeile + + if (Fo_triggered) then + write(lunTMP,'(A)') ' (NTupeleintrag getriggert durch TD-Folien-Treffer)' + elseif (xM2_triggered) then + write(lunTMP,'(A)') ' (NTupeleintrag getriggert durch Erreichen der MCP2-Ebene)' + elseif (M2_triggered) then + write(lunTMP,'(A)') ' (NTupeleintrag getriggert durch MCP2-Treffer)' + else + write(lunTMP,'(A)') ' (alle Events in NTupel aufnehmen)' + endif + endif + + if (smearS1Fo) write(lunTMP,'(A,F5.2)') 'S1Fo gefaltet mit sigma = ',sigmaS1Fo + + +c Graphikausgabe: +c --------------- + + if (GRAPHICS) then + if (generate_FE) then + if (plot_FE) then + zeile = 'Graphikausgabe incl. FE-Trajektorien' + pos = 38 + else + zeile = 'Graphikausgabe ohne FE-Trajektorien' + pos = 37 + endif + else + zeile = 'Graphikausgabe' + pos = 16 + endif + if (n_postSkript.EQ.0) then + write(zeile(pos:pos+18),'(A)')'(keine Postskripts)' + elseif (n_postSkript.EQ.1) then + write(zeile(pos:pos+24),'(A)')'(Postskripts auf Anfrage)' + elseif (n_postSkript.EQ.2) then + write(zeile(pos:pos+17),'(A)')'(alle Postskripts)' + endif + write(lunTMP,'(A)') zeile + if (vertical) then + write(lunTMP,'(A,I3,'','',I5,A)') '- iMonitor = ',iMonitor, + + graphics_Anzahl,' Trajektorien pro Schleife, vertical view' + else + write(lunTMP,'(A,I3,'','',I5,A)') '- iMonitor = ',iMonitor, + + graphics_Anzahl,' Trajektorien pro Schleife, horizontal view' + endif + write(zeile,121) schnitt_x, schnitt_p +121 format('- Schnittebene bei x = ',F6.1,' im ',I1, + + '. Kammerteil') + write(lunTMP,'(A)') zeile + endif + + if (write_geo) write(lunTMP,'(A)') '.GEO-file erstellen' + + if (.NOT.(createPhysTab.AND.createNTP.AND.GRAPHICS.AND.write_geo)) then + zeile = '> NICHT ERZEUGT:' + pos = 18 + if (.NOT.createPhysTab) then + write(zeile(pos:pos+15),'(A)') 'PHYSICA-TABELLE,' + pos = pos + 16 + endif + if (.NOT.createNTP) then + write(zeile(pos:pos+6),'(A)')'NTUPEL,' + pos = pos + 7 + endif + if (.NOT.GRAPHICS) then + write(zeile(pos:pos+7),'(A)')'GRAPHIK,' + pos = pos + 8 + endif + if (.NOT.write_geo) then + write(zeile(pos:pos+8),'(A)')'GEO-FILE,' + pos = pos + 9 + endif + pos = pos - 1 + write(zeile(pos:pos),'(A)')' ' + write(lunTMP,'(A)') zeile + endif + + +c Debug: +c------- + + if (DEBUG) then + write(zeile,132) Debug_Anzahl +132 format('DEBUG-INFORMATIONEN IM LOG-file:',I3, + + ' Projektile je Schleife') + if (DEBUG_FE) write(zeile(59:68),'(A10)') ', incl. FE' + write(lunTMP,'(A)') zeile + if (.NOT.graphics) then + write(lunTMP,'(A,I3)') '- iMonitor = ',iMonitor + endif + endif + + +c Fehlerbetrachtung: +c ------------------ + + write(zeile,141) eps_x,eps_v,dtsmall,maxStep +141 format('eps_x,eps_v = ',E8.3,',',E8.3,T42,', dtsmall = ',F8.6, + + ', maxstep = ',I6) + if (log_relativ) then + write(zeile(33:41),'(A9)') '(relativ)' + else + write(zeile(33:41),'(A9)') '(absolut)' + endif + write(lunTMP,'(A)') zeile + write(lunTMP,'(A,I5)') 'maxBelowDtSmall = ',maxBelowDtSmall +d if (log_confine) then +d if (lense2) then +d write(lunTMP,142) ' Schrittweitenbegrenzung: L1,L2andFO,L3,M2: ', +d + dl_max_L1,dl_max_L2andFo,dl_max_L3,dl_max_M2 +d else +d write(lunTMP,142) ' Schrittweitenbegrenzung: L1,FO,L3,M2: ', +d + dl_max_L1,dl_max_Fo,dl_max_L3,dl_max_M2 +d endif +d endif +d142 format(x,A,4(F6.3,:,', ')) + + +c Logfile: +c -------- + + if (.NOT.Logfile) then + if (smallLogFile) then + write(lunTMP,'(A)') 'KLEINES LOGFILE' + else + write(lunTMP,'(T30,A)') '>>> KEIN LOGFILE <<<' + endif + endif + + write(lunTMP,'(A)') strich2 + + +c Kommentarzeilen aus der Eingabedatei MUTRACK.INPUT: +c --------------------------------------------------- + +c da das PHYSICA file erst spaeter geoeffnet wird kann die entsprechende unit +c hier temporaer fuer den Anschluss der Eingabedatei verwendet werden + + open(lunPHYSICA,file=inputName,defaultfile=readDir//':.INPUT', + + status='OLD',readonly) + flag = .false. +554 read(lunPHYSICA,'(A)') zeile + do while (INDEX(zeile,'$loop_params').EQ.0 .AND. + + INDEX(zeile,'$parameter_liste').EQ.0) + if (zeile(1:1).EQ.'@') then + write(lunTMP,'(A)') zeile + flag = .true. + endif + goto 554 + enddo + + close(lunPHYSICA) + + if (flag) write(lunTMP,'(A)') strich2 + + if (TestRun) then + write(lunTMP,'(A)') '######################## >>>>> '// + + 'T E S T - R U N <<<<< ########################' + write(lunTMP,'(A)') strich2 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_VARNAMES +c ======================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + integer pos + + character*80 varNames,loopZeile,parValues /' '/ + COMMON /zeilen/ varNames,loopZeile,parValues + +c die Zeile 'varNames' mit den Namen derjenigen Schleifen-Parameter +c zusammenstellen, die mehr als einen Wert annehmen (in der Reihenfolge, wie +c sie auch als Schleifen abgearbeitet werden): + + varNames = ' ' + pos = 1 + +c Foliendicke: +c ------------ + + if (n_par(Thickn).GT.1) then + varNames(pos:pos+10) = ' Thickness' + pos = pos+11 + endif + +c MCP2: +c ----- + + if (n_par(UMCP2).GT.1) then + varNames(pos:pos+10) = ' U(MCP2)' + pos = pos+11 + endif + +c Drehwinkel: +c ----------- + + if (n_par(alfTgt).GT.1) then + varNames(pos:pos+8) = 'alfa(Tgt)' + pos = pos+9 + endif + if (n_par(alfSp).GT.1) then + varNames(pos:pos+8) = ' alfa(Sp)' + pos = pos+9 + endif + if (n_par(alfTD).GT.1) then + varNames(pos:pos+8) = ' alfa(TD)' + pos = pos+9 + endif + +c 'artList' bzw. Masse und Ladung: +c -------------------------------- + + if (artList_defined) then + if (n_par(charge).GT.1) then ! mehr als eine + varNames(1:6) = ' Art ' ! Art spezifiziert + pos = 7 + endif + else + if (n_par(mass).GT.1) then + varNames(pos:pos+12) = ' Masse' + pos = pos+13 + endif + if (n_par(charge).GT.1) then + varNames(pos:pos+3) = ' Q' + pos = pos+4 + endif + endif + +c Triggerdetektor: +c ---------------- + + if (n_par(UFolie).GT.1) then + varNames(pos:pos+10) = ' U(Folie)' + pos = pos+11 + endif + if (n_par(UVorne).GT.1) then + varNames(pos:pos+10) = ' U(Vorne)' + pos = pos+11 + endif + if (n_par(UHinten).GT.1) then + varNames(pos:pos+10) = ' U(Hinten)' + pos = pos+11 + endif + if (n_par(UMCP3).GT.1) then + varNames(pos:pos+10) = ' U(MCP3)' + pos = pos+11 + endif + +c Transportsystem: +c ---------------- + + if (n_par(UTgt).GT.1) then + varNames(pos:pos+10) = ' U(Target)' + pos = pos+11 + endif + if (n_par(UGua).GT.1) then + varNames(pos:pos+10) = ' U(Guard)' + pos = pos+11 + endif + if (n_par(UG1).GT.1) then + varNames(pos:pos+10) = ' U(Gitter)' + pos = pos+11 + endif + if (n_par(UL1).GT.1) then + varNames(pos:pos+10) = ' U(L1)' + pos = pos+11 + endif + if (n_par(USp).GT.1) then + varNames(pos:pos+10) = ' U(Spiegel)' + pos = pos+11 + endif + if (n_par(UL2).GT.1) then + varNames(pos:pos+10) = ' U(L2)' + pos = pos+11 + endif + if (n_par(UL3).GT.1) then + varNames(pos:pos+10) = ' U(L3)' + pos = pos+11 + endif + +c Magnetfelder: +c ------------- + + if (n_par(BHelm).GT.1) then + varNames(pos:pos+10) = ' B(Helm)' + pos = pos+11 + endif + if (n_par(BTD).GT.1) then + varNames(pos:pos+10) = ' B(TD)' + pos = pos+11 + endif + +c Startparameter: +c --------------- + + if (n_par(ener).GT.1) then + varNames(pos:pos+10) = ' Energie' + pos = pos+11 + endif + + if (n_par(yPos).GT.1) then + varNames(pos:pos+8) = ' y0' + pos = pos+9 + endif + if (n_par(zPos).GT.1) then + varNames(pos:pos+8) = ' z0' + pos = pos+9 + endif + + if (n_par(thetAng).GT.1) then + varNames(pos:pos+8) = ' phi0' + pos = pos+9 + endif + if (n_par(phiAng).GT.1) then + varNames(pos:pos+8) = ' theta0' + pos = pos+9 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_ParValues +c ========================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + integer pos + + character*80 varNames,loopZeile,parValues /' '/ + COMMON /zeilen/ varNames,loopZeile,parValues + +c die Zeile 'varValues' mit den aktuellen Werten derjenigen Schleifen-Parameter +c zusammenstellen, die mehr als einen Wert annehmen (in der Reihenfolge, wie +c sie auch als Schleifen abgearbeitet werden): + + parValues = ' ' + pos = 1 + +c Foliendicke: +c ------------ + + if (n_par(Thickn).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(Thickn) + pos = pos+11 + endif + +c MCP2: +c ----- + + if (n_par(UMCP2).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UMCP2) + pos = pos+11 + endif + +c Drehwinkel: +c ----------- + + if (n_par(alfTgt).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(alfTgt) + pos = pos+9 + endif + if (n_par(alfSp).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(alfSp) + pos = pos+9 + endif + if (n_par(alfTD).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(alfTD) + pos = pos+9 + endif + +c 'artList' bzw. Masse und Ladung: +c -------------------------------- + + if (artList_defined) then + if (n_par(charge).GT.1) then + write(parValues(2:5),'(A4)') art_Name(artNr) + pos = 7 + endif + else + if (n_par(mass).GT.1) then + write(parValues(pos+1:pos+12),'(F12.2)') parWert(6) + pos = pos+13 + endif + if (n_par(charge).GT.1) then + write(parValues(pos+2:pos+3),'(SP,I2)') INT(parWert(5)) + pos = pos+4 + endif + endif + + +c Triggerdetektor: +c ---------------- + + if (n_par(UFolie).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UFolie) + pos = pos+11 + endif + if (n_par(UVorne).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UVorne) + pos = pos+11 + endif + if (n_par(UHinten).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UHinten) + pos = pos+11 + endif + if (n_par(UMCP3).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UMCP3) + pos = pos+11 + endif + +c Transportsystem: +c ---------------- + + if (n_par(UTgt).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UTgt) + pos = pos+11 + endif + if (n_par(UGua).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UGua) + pos = pos+11 + endif + if (n_par(UG1).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UG1) + pos = pos+11 + endif + if (n_par(UL1).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UL1) + pos = pos+11 + endif + if (n_par(USp).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(USp) + pos = pos+11 + endif + if (n_par(UL2).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UL2) + pos = pos+11 + endif + if (n_par(UL3).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(UL3) + pos = pos+11 + endif + +c Magnetfelder: +c ------------- + + if (n_par(BHelm).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(BHelm) + pos = pos+11 + endif + if (n_par(BTD).GT.1) then + write(parValues(pos+2:pos+10),'(F9.2)') parWert(BTD) + pos = pos+11 + endif + +c Startparameter: +c --------------- + + if (n_par(ener).GT.1) then + write(parValues(pos+1:pos+10),'(F10.3)') parWert(ener) + pos = pos+11 + endif + + if (n_par(yPos).GT.1) then + write(parValues(pos+2:pos+8),'(F7.2)') parWert(yPos) + pos = pos+9 + endif + if (n_par(zPos).GT.1) then + write(parValues(pos+2:pos+8),'(F7.2)') parWert(zPos) + pos = pos+9 + endif + + if (n_par(thetAng).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(ThetAng) + pos = pos+9 + endif + if (n_par(phiAng).GT.1) then + write(parValues(pos+3:pos+8),'(F6.1)') parWert(phiAng) + pos = pos+9 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE OUTPUT_NEW_LOOP(q_) +c ============================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + + integer k, par_, iostat + real q_ ! gegebenenfalls Nr der Ladungsschleife, benoetigt + ! fuer Ausgabe der neutralen Anteile nach TD-Folie + + character*80 varNames,loopZeile,parValues /' '/ + COMMON /zeilen/ varNames,loopZeile,parValues + + character datum*9,uhrzeit*8 + + + if (SchleifenNr.EQ.1) then + write(*,'(A)')'==========================='// + + '=====================================================' + if (OneStartPerLoop) then + do indx = indx1, indx2 +c if (Gesamtzahl.GT.1) then + write(lun(indx),*) 'Nur ein Start pro '// + + 'Schleife => Summary geht ueber alle Schleifen' +c else +c write(lun(indx),*) 'Nur ein Start => kein ' +c + 'Summary' +c endif + enddo + goto 10 + endif + endif + + +c die Zeile mit der Schleifennummer und dem Startnummernbereich der +c Schleife erstellen: (n_par(0) = #(StartsProSchleife)) + + write(loopZeile(1:80),999)SchleifenNr,SchleifenZahl, + + (SchleifenNr-1)*n_par(0)+1,SchleifenNr*n_par(0) +999 format (' >>> Schleife :',2X,I4,' von ',I4,T43,'Start-Nr: ', + + I8,' bis ',I8) + + +c falls Run im BATCH_MODE laeuft: gib 'loopZeile' in die Datei 'filename.MESSAG +c aus, damit man sich jederzeit informieren kann, an welcher Stelle der Run ge- +c rade steht: + + if (BATCH_MODE) then + if (INPUT_LIST) then + open(lunMessage,file='MU_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + read (lunMessage,*,iostat=iostat) ! Nr. der Input-Datei in INPUT_LIST.INPUT + else + open(lunMessage,file='MUTRACK.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + endif + read (lunMessage,*,iostat=iostat) ! Startzeitpunkt + read (lunMessage,*,iostat=iostat) ! Name der Input-Datei in INPUT_LIST.INPUT + write(lunMessage,*,iostat=iostat) filename + write(lunMessage,*,iostat=iostat) loopZeile + call date(datum) + call time(uhrzeit) + write(lunMessage,*,iostat=iostat) ' started on '//datum//' at '//uhrzeit + close(lunMessage,iostat=iostat) + endif + + +c die aktuellen Einstellungen der variablen Parameter in 'parValues' schreiben: + + if (smallLogfile.OR.createTabellen) call Make_parValues + + +c falls nur die Minimalversion der .LOG-Datei erstellt werden soll, schreibe +c die entsprechenden Zeilen in die Datei: + + if (smallLogFile) then + write(lun(1),'(A)') loopZeile + write(lun(1),'(A)') parValues + write(lun(1),*) + endif + + +c gib die aktuellen Einstellungen der variablen Parameter (parWert) aus: +c (hier Zeile fuer Zeile) + + if (n_outWhere.NE.0) then + do 1, indx = indx1, indx2 + write(lun(indx),'(A)')loopZeile + do k=1, par_anzahl + par_ = reihenfolge(k) + if (par_.EQ.ener .AND. e0InterFromFile) then + write(lun(indx),1002) nint(parWert(ener)),lowerE0,upperE0 + elseif (n_par(par_).GT.1) then + if (par_.EQ.charge .AND. artList_defined) then + if (log_neutralize) then + write(lun(indx),1000) art_Name(artNr), + + neutral_fract(q_) + else + write(lun(indx),1000) art_Name(artNr) + endif + else + write(lun(indx),1001) par_text(par_)(1:10), + + parWert(par_) + endif + endif + enddo +1 continue + endif +1000 format (X,' >>> Projektil :',7X,A,:' (neutr. fract. = 'F5.1'%)') +1001 format (X,' >>> ',A,': ',F10.3) +1002 format (X,' >>> ',I3,'. E0-Intervall: [',F8.3,',',F8.3,']') + + +c gib gegebenenfalls den gemaess ICRU Tabelle berechneten mittleren Energie- +c verlust in der Triggerfolie aus: + +10 if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then + do indx = indx1, indx2 + write(lun(indx),1001) 'Eloss-ICRU',mean_E_Verlust + enddo + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE GRAPHICS_TEXT +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + integer k,zeile,par_ + integer GraphTextZeilen /15/ + + character graphText(15)*40 /15*' '/ + COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText + + if (OneStartPerLoop) then + graphText(2) = filename + graphText(4) = 'Ein Start pro Schleife, daher' + graphText(5) = 'alle Kurven in einer Graphik.' + graphText(7) = 'Settings entsprechend Logfile.' + else + graphText(1) = filename + if (OneLoop) then + graphText(3) = 'Nur eine Schleife -> keine' + graphText(4) = 'veraenderlichen Parameter' + else + write(graphText(2),900) SchleifenNr,SchleifenZahl +900 format('Schleife ',I5,' von ',I6) + zeile = 3 + do k=1, par_anzahl + + par_ = reihenfolge(k) + if (n_par(par_).GT.1) then + if (zeile.EQ.15) then + write(graphText(zeile)(28:30),'(A3)') '...' + RETURN + endif + if (par_.EQ.charge .AND. artList_defined) then + write(graphText(zeile),1000) art_Name(artNr) + elseif ( + + ((par_.EQ.ener).AND.random_E0) .OR. + + ((par_.EQ.yPos.OR.par_.EQ.zPos).AND.random_pos) .OR. + + ((par_.EQ.phiAng.OR.par_.EQ.thetAng).AND.random_angle) )then + write(graphText(zeile),1001) par_text(par_)(1:10), + + parWert(par_),' + random' + else + write(graphText(zeile),1001) par_text(par_)(1:10), + + parWert(par_) + endif + zeile = zeile+1 + endif + enddo + endif + endif + +1000 format (X,' Projektil = ',7X,A) +1001 format (X,' ',A,' = ',F10.3,:A) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE OUTPUT_TABELLEN +c ========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + integer i,k, bufferPos /0/ ,indcs + + real buffer(LwPerRec) + integer what2indx(5) /6,7,4,5,9/ + + ! mean = statMem(6,k) + ! Varianz = statMem(7,k) + ! min = statMem(4,k) + ! max = statMem(5,k) + ! prozent = statMem(9,k) + + character*80 varNames,loopZeile,parValues + COMMON /zeilen/ varNames,loopZeile,parValues + + SAVE bufferPos + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c I. Die speziellen Tabellen: + +c gib die Zeile mit den aktuellen Werten der veraenderlichen Parameter und die +c Statistiken aus: + + if (createTabellen) then + do k = 1, stat_Anzahl + if (createTabelle(k)) then + write(lunPHYSICA+k,'(A)') parValues + write(lunPHYSICA+k,1000) SchleifenNr, + + statMem(6,k),statMem(7,k),statMem(4,k), + + statMem(5,k),int(statMem(8,k)),statMem(9,k) + write(lunPHYSICA+k,'(A)')'_________________________'// + + '_______________________________________________________' + endif + enddo + endif +1000 format(X,I4,4X,F9.2,2X,F7.2,9X,F9.2,X,F9.2,10X,I6,2X,F6.1) +c ^Nr ^mean ^sigma ^von ^bis ^anzahl ^% + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c II. Die PHYSICA - Tabelle: mean, Varianz, min, max, prozent + + if (createPhysTab) then + do k = 1, StatAnzahlPHY + do i = 1, whatAnzahlPHY + indcs = what2indx(whatList(i)) + bufferPos = bufferPos + 1 + buffer(bufferPos) = statMem(indcs,statList(k)) + if (bufferPos.EQ.LwPerRec) then + write(lunPHYSICA) buffer + bufferPos = 0 + endif + enddo + enddo + + if (.NOT.notLastLoop) then + write(lunPHYSICA) (buffer(k), k=1,bufferPos) + close (lunPHYSICA) + endif + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE OUTPUT_NEW_PARTICLE +c ============================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + integer startNr ! = absolute Startnummer + + if (OneStartPerLoop) then + startNr = Start_Nr(1) + else + startNr = (SchleifenNr-1)*n_par(0) + Start_nr(1) + endif + + write(lunLOG,*) + write(lunLOG,'(A,I8)') 'Teilchen Nr. ',startNr + if (random_E0) then + write(lunLOG,'(A,F)')'Startenergie : ',parWert(ener) + endif + if (random_angle) then + write(lunLOG,'(A,F)')'Startwinkel (theta): ',parWert(thetAng) + write(lunLOG,'(A,F)')'Startwinkel (phi) : ',parWert(phiAng) + endif + if (random_pos) then + write(lunLOG,'(A,F)')'Startposition (y) : ',parWert(yPos) + write(lunLOG,'(A,F)')'Startposition (z) : ',parWert(zPos) + endif + + write(lunLOG,1001) 'STEP','GEBIET','T','X','Y','Z','Vx', + + 'Vy','Vz','E' + +1001 format (T2,A,T7,A,T17,A,T25,A,T32,A,T39,A,T47,A,T54,A, + + T61,A,T71,A) + + + END + + +C=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SUMMARY +c ================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real proz ! fuer Umrechnungen in Prozent + + integer k ! Zaehlvariable + integer offset ! + integer nr ! die Nummer eines Scalers oder Pfostens + integer summe ! fuer Summenbildungen + integer code_,ZahlDestiny + + character GebietText*15 + + character PfostenText(3)*26 + + / 'direkt:', + + 'nach Reflexion an HINTEN:', + + 'nach Reflexion an MCP3:' / + + logical output_TD_code(11) / 11*.false. / + COMMON /TD_CODE/ output_TD_code + + integer nNeutral,nCharged + common /nNeutral/ nNeutral,nCharged + +1000 format (X,A,:,T47,I8,' (=',F5.1,'%)') ! destiny (gesamt) +1001 format (T5,A, T47,I8,' (=',F5.1,'%)') ! destiny (je Gebiet) +1002 format (T10,A,T47,I8,' (=',F5.1,'%)') ! Pfosten: direkt oder nach Refl.? +1003 format (T10,A1,I3,': ',T17,I5,' (=',F5.1,'%)') ! 'P' und 'M' + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c fuer alle Ausgabekanaele: + + do 3, indx = indx1, indx2 + + if (.NOT.(lun(indx).EQ.lunLog .AND. smallLogFile)) then + + write(lun(indx),'(A)')'- - - - - - - - - - - - - - - - - - '// + + '- - - - - - - - - - - - - - - - - - - - - -' + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + +c die Projektil-Statistik: +c ------------------------ + + proz = 100./start_nr(1) + +c - Ausgabe der Teilchenschicksale mit Code-Nummern <= 0: + + do code_ = code_ok, smallest_code_Nr, -1 + if (code_.EQ.code_ok .OR. statDestiny(code_).NE.0) then + write(lun(indx),*) + if (code_.EQ.code_ok .AND. (createFoilFile.OR.upToTDFoilOnly)) then + write(lun(indx),1000) 'TD-Folie getroffen:', + + statDestiny(code_ok),statDestiny(code_ok)*proz + else + write(lun(indx),1000) code_text(code_), + + statDestiny(code_),statDestiny(code_)*proz + endif + if (code_.EQ.code_lostInTD) then + do nr = 1, 14 + if (statTD(1,nr).NE.0) then + write(lun(indx),1003) 'M',100+nr, + + statTD(1,nr),statTD(1,nr)*proz + output_TD_code(nr) = .true. + endif + enddo + endif + endif + enddo + + +c - Ausgabe der Teilchenschicksale mit Code-Nummern > 0: + + do code_ = 1, highest_code_Nr + + !c Teste, ob spezielles Teilchenschicksal ueberhaupt auftrat: + summe = 0 + do Gebiet = 1, Gebiete_Anzahl + summe = summe + statDestiny((Gebiet-1)*highest_code_Nr + code_) + enddo + + ! falls ja, gib aus, wie oft Schicksal insgesamt erlitten wurde, + ! und wie oft es in den einzelnen Gebieten erlitten wurde: + if (summe.GT.0) then + write(lun(indx),*) + write(lun(indx),1000) code_text(code_),summe, + + real(summe)*proz + do Gebiet = 1, Gebiete_Anzahl + ZahlDestiny = statDestiny((Gebiet-1)*highest_code_Nr+code_) + if (ZahlDestiny.NE.0) then + if (code_.EQ.code_vorbei) then + if (Gebiet.EQ.upToL1Map) then + GebietText = 'Linse 1:' + elseif (Gebiet.EQ.upToEnSp) then + GebietText = 'Spiegel:' + elseif (Gebiet.EQ.upToL2andFoMap) then + GebietText = 'Linse 2:' + elseif (Gebiet.EQ.upToEnTD) then + GebietText = 'Triggerfolie:' + elseif (Gebiet.EQ.upToL3Map) then + GebietText = 'Linse 3:' + elseif (Gebiet.EQ.upToMCP2) then + GebietText = 'MCP2:' + endif + write(lun(indx),1001) GebietText, + + ZahlDestiny,ZahlDestiny*proz + else + ! + !---------------! (brauche mehr Platz) + ! + if (log_out_pfosten(1).AND. + + code_.EQ.code_wand.AND.Gebiet.EQ.upToExTD) then + ! getroffene Pfosten ausgeben: + write(lun(indx),1001) Gebiet_Text(gebiet) ! 'im Trigger-Detektor' + + if (statTD(1,16).NE.0) write(lun(indx),1002) + + 'MCP3',statTD(1,16),statTD(1,16)*proz + + do k= 1, 3 ! k=1: direkt getroffen + offset= (k-1)*25 ! k=2: nach Refl. an HINTEN + summe = 0 ! k=3: nach Refl. an MCP3 + do nr = offset+1, offset+25 + summe = summe + pfostenHit(nr,1) + enddo + if (summe.GT.0) then + write(lun(indx),1002)PfostenText(k),summe,summe*proz + do nr = offset+1, offset+25 + if (pfostenHit(nr,1).NE.0) then + write(lun(indx),1003) 'P',nr-offset, + + pfostenHit(nr,1),pfostenHit(nr,1)*proz + endif + enddo + endif + enddo + else + write(lun(indx),1001) Gebiet_Text(gebiet), + + ZahlDestiny,ZahlDestiny*proz + endif + ! + !---------------! + ! + endif + endif + enddo + endif + enddo + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Die Folienelektronen-Statistik: +c ------------------------------- + + if (log_out_FE .AND. start_nr(2).GT.0) then + write(lun(indx),*) + + proz = 100./start_nr(2) + + if (start_nr(2).EQ.0) then + write(lun(indx),'(A)')'KEINE FOLIENELEKTRONEN GESTARTET' + goto 2 + endif + + write(lun(indx),1005) start_nr(2) +1005 format(' *FOLIENELEKTRONEN (100%=',I5,'):') + write(lun(indx),1000) 'MCP3 erreicht:',statTD(2,16), + + statTD(2,16)*proz + if (statTD(2,17).NE.0) then + write(lun(indx),1000) 'auf Gitterstaebe:',statTD(2,17), + + statTD(2,17)*proz + endif + if (statTD(2,18).NE.0) then + write(lun(indx),1000) 'in MCP3 nicht nachgew.:',statTD(2,18), + + statTD(2,18)*proz + endif + +c - abgebrochenen Trajektorien: + summe = 0 + do nr = 1, 14 + summe = summe + statTD(2,nr) + enddo + + if (summe.NE.0) then + write(lun(indx),1000) 'Berechnung abgebrochen:', + + summe, summe*proz + do nr = 1, 14 + if (statTD(2,nr).NE.0) then + write(lun(indx),1003) 'M',100+nr,statTD(2,nr), + + statTD(2,nr)*proz + output_TD_code(nr) = .true. + endif + enddo + endif + + +c - getroffene Pfosten und GROUND-Treffer: + + ! irgendwelche Pfosten getroffen? + summe = 0 + do nr = 1,75 + summe = summe + pfostenHit(nr,2) + enddo + if (summe.GT.0) then + if (.NOT.log_out_pfosten(2)) then + write(lun(indx),1000) 'aufgeschlagen:',summe, + + summe*proz + else + write(lun(indx),1000) 'aufgeschlagen:' + do k= 1, 3 ! k=1: direkt getroffen + offset= (k-1)*25 ! k=2: nach Refl. an HINTEN + summe = 0 ! k=3: nach Refl. an MCP3 + do nr = offset+1, offset+25 + summe = summe + pfostenHit(nr,2) + enddo + if (summe.GT.0) then + write(lun(indx),1002)PfostenText(k),summe, + + summe*proz + do nr= offset+1, offset+25 + if (pfostenHit(nr,2).NE.0) then + write(lun(indx),1003) 'P',nr-offset, + + pfostenHit(nr,2),pfostenHit(nr,2)*proz + endif + enddo + endif + enddo + endif + endif + if (statTD(2,15).NE.0) write(lun(indx),1000) + + 'auf Ground getroffen:',statTD(2,15),statTD(2,15)*proz + endif + + endif ! if (.NOT.(lun(indx).EQ.lunLog .AND. smallLogFile)) then ... + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ergebnis-Spiegel ausgeben: +c -------------------------- + +2 if (statsInSummary) then + write(lun(indx),*) + write(lun(indx),'(A)') '- - - - - - - - mean - - Varianz'// + + '- - - - - von - - - bis - - - - - Anzahl - - % -' + + do k = 1, stat_Anzahl + if (statInSummary(k)) then + if (statMem(8,k).NE.0) then + write(lun(indx),1006) statName(k),statMem(6,k), + + statMem(7,k),statMem(4,k),statMem(5,k), + + int(statMem(8,k)),statMem(9,k) + else + write(lun(indx),'(x,A9,'':'',T25,A)') + + statName(k),' - - - - - keine Eintraege - - - - -' + endif + endif + enddo + endif + + +1006 format (x,A9,':',T14,F9.2,T26,F7.2,T39,F9.2,T49,F9.2,:,T66,I7, + +T75,F6.1) +c ^% ^mean ^sigma ^von ^bis ^anzahl +c +c sigma(N) = sqrt( ( S(x^2)-((S(x))^2)/n )/n ) +c sigma(N-1) = sqrt( ( S(x^2)-((S(x))^2)/n )/(n-1) ) + + if (log_neutralize) then + write(lun(indx),*) 'neutraler Anteil nach TD-Folie [%]: ',100.*real(nNeutral)/real(nNeutral+nCharged) + endif + + write(lun(indx),'(A)') '=================================='// + +'==============================================' + +3 continue ! 'fuer alle Ausgabekanaele ...' + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE TERMINATE_OUTPUT +c =========================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + + integer k, iostat + character datum*9,uhrzeit*8 + character zeile*80 + real prozent + + logical output_TD_code(11), flag /.false./ + COMMON /TD_CODE/ output_TD_code + + character text(11)*70 / + + 'Startposition auf Folientraeger' + + ,' ' + + ,'Start in negative x-Richtung' + + ,'Teilchen zwischen FOLIE und VORNE reflektiert' + + ,'v_x=0 und U(FOLIE,VORNE)=0 -> Teilchen steht' + + ,'Teilchen zwischen HINTEN und GROUND reflektiert' + + ,'Reflektion bei MCP3 und bei HINTEN' + + ,'Teilchen zurueck auf Gitter V1' + + ,'Reflektion bei HINTEN und bei MCP3' + + ,'Teilchen zwischen VORNE und MCP3 reflektiert mit v_x <=0' + + ,'Teilchen bleibt stehen' / + +c - - - - - - - - - - - - - - - - - - - - - - - - - - + +c if (createFoilFile) close (lunFOIL) + + +c das NTP-File schliessen: + + if (createNTP.OR.createFoilFile) then + call HCDIR('//MUwrite',' ') + call HROUT(NTP_write,iostat,' ') ! NTP in Datei schreiben + call HREND('MUwrite') ! HBOOK-Datei schliessen + close(lunNTP) ! zugehoerige Fortran-Datei schliessen + endif + + + prozent = 100./real(start_Nr(1)+(SchleifenNr-1)*n_par(0)) + + do k = 1 , 11 + if (output_TD_code(k)) flag = .true. + enddo + + indx = lunScreen +1 continue + + if (flag) then + write(indx,*)'TD-Meldungen:' + do k = 1 , 11 + if (output_TD_code(k)) then + write(indx,1000) k+100,text(k) + endif + enddo + endif +1000 format(T5,'M',I3,': ',A) + + if (dtsmall_counter.GT.0) then + write(indx,1002) dtsmall_counter,dtsmall_counter*prozent + write(indx,1003) n_dtsmall_Max + write(indx,*) + endif + if (LostInTD_counter.NE.0) then + write(indx,1004) lostInTD_counter,lostInTD_counter*prozent + write(indx,*) + endif + if (Lost_counter.NE.0) then + write(indx,1005) Lost_counter,Lost_counter*prozent + write(indx,*) + endif +1002 format(x,'Bei ',I5,' Trajektorienberechnungen wurde ', + + 'dtsmall unterschritten',T73,'(',F5.1,'%)') +1003 format(x,'(Im Maximalfall wurden ',I3,' Unterschreitungen von', + + ' dtsmall resettet)') +1004 format(x,'Im TD wurden ',I7,' Trajektorienberechnungen ', + + 'abgebrochen',T73,'(',F5.1,'%)') +1005 format(x,'wegen steps > maxStep wurden ',I5, + + ' Trajektorienberechnungen abgebrochen',T73,'(',F5.1,'%)') + + call date(datum) + call time(uhrzeit) + if (notLastLoop) then + write(zeile,2000) datum, Uhrzeit, fileName + else + write(zeile,2001) datum, Uhrzeit, fileName + endif +2000 format('Simulation ABGEBROCHEN am ',A9,' um ',A8,T73,A7) +2001 format('Simulation beendet am ',A9,' um ',A8,T73,A7) + write(indx,*) zeile + if (notLastLoop) write(indx,*)' ***********' + write(indx,'(A)')'====================================='// + + '===========================================' + + if ((logFile.OR.smallLogFile) .AND. indx.NE.lunLOG) then + indx = lunLog + goto 1 + endif + + +c das Summary-File und die Tabellen-Files schliessen: + + if (LogFile.OR.smallLogFile) then + if (debug) then + write(lunLog,'(A)') ' Die Gebietskodierung:' + write(lunLog,*) + do k = 1, Gebiete_Anzahl + indx = index(Gebiet_Text(k),':') + write (lunLog,1001) k,Gebiet_Text(k)(1:indx-1) + enddo + write(lunLog,'(A)')'=============================='// + + '==================================================' + endif + close (lunLog) + endif +1001 format(T4,I3,': ',A) + + do k = 1, Stat_Anzahl + if (createTabelle(k)) close (lunPHYSICA+k) + enddo + + +c falls Run im BATCH_MODE laeuft: loesche das '.MESSAGE' file: + + if (BATCH_MODE) then + if (INPUT_LIST) then + open(lunMessage,file='MU_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + else + open(lunMessage,file='MUTRACK.MESSAGE',defaultfile='SYS$SCRATCH:', + + status='UNKNOWN',iostat=iostat) + endif +c "STATUS='DELETE'" entfernt, damit .MESSAGE-Datei von "SUB_LIST.COM" die Nummer +c des zuletzt abgearbeiteten INPUT-Files gelesen werden kann. +c close(lunMessage,status='DELETE',iostat=iostat) + close(lunMessage,iostat=iostat) + endif + + +c zum Abschluss zwei Leerzeilen auf den Bildschirm geben: + + write(*,*) + write(*,*) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE WRITE_GEO_FILE +c ========================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + real x_intersectTD ! Schnittpunkt der x-Achse mit der Folienebene + ! bzw im Fall von 'GridInFrontOfFoil' mit dem + ! Gitter vor der Triggerfolie + real x_intersectTDMap + common /x_intersectTD/ x_intersectTD,x_intersectTDMap + + real help,trans,totTrans + + open (lunTMP,File=fileName//'.GEO',status='NEW',defaultfile=outDir) +c + ,carriagecontrol ='NONE') + + write(lunTMP,*) + write(lunTMP,*) fileName//geo_fileName + write(lunTMP,*) + write(lunTMP,*) 'Zugrundeliegende Kammergeometrie' + write(lunTMP,*) '================================' + write(lunTMP,*) + write(lunTMP,*) 'Im ersten Kammerteil (vom Moderator bis zum Spiegel) wird ''x'' relativ' + write(lunTMP,*) 'zur Kryoachse gemessen, im zweiten Kammerteil (vom Spiegel bis zum MCP2)' + write(lunTMP,*) 'relativ zur Spiegelaufhaengung (Zentrum des Doppelkreuzes).' + write(lunTMP,*) + write(lunTMP,*) 'Alle Laengenangaben in mm, jeweils volle Breiten und Hoehen.' + write(lunTMP,*) + write(lunTMP,*) + write(lunTMP,*) 'Vakuumrohr:' + write(lunTMP,*) '-----------' + write(lunTMP,1000) 'radius_Rohr',radius_Rohr + write(lunTMP,*) + write(lunTMP,*) 'Beschleuniger:' + write(lunTMP,*) '--------------' + if (Use_ACCEL) then + write(lunTMP,1001) 'verwendete Simulationsdatei',fileName_ACCEL + endif + write(lunTMP,1000) 'x-Position der Moderatorfolie',xtarget + write(lunTMP,1000) 'Breite der Moderatorfolie',dytarget + write(lunTMP,1000) 'Hoehe der Moderatorfolie',dztarget + write(lunTMP,1000) 'x-Position des 1. Gitters',xgrid1 + write(lunTMP,1000) 'Position relativ zum Moderator',xgrid1-xTarget + write(lunTMP,1000) 'Breite des 1. Gitters',dygrid1 + write(lunTMP,1000) 'Hoehe des 1. Gitters',dzgrid1 + if (TestOnWireHit.OR.Use_ACCEL) then + write(lunTMP,1000) 'Drahtdurchmesser',dWires_G1 + write(lunTMP,1000) 'Drahtabstand',dist_Wires_G1 + trans = 1.-dWires_G1/dist_Wires_G1 + write(lunTMP,1000) '=> Transmission (Gitter 1)',trans + totTrans = trans + endif + write(lunTMP,1000) 'x-Position des 2. Gitters',xgrid2 + write(lunTMP,1000) 'Position relativ zum Moderator',xgrid2-xTarget + write(lunTMP,1000) 'Breite des 2. Gitters',dygrid2 + write(lunTMP,1000) 'Hoehe des 2. Gitters',dzgrid2 + if (TestOnWireHit.OR.Use_ACCEL) then + write(lunTMP,1000) 'Drahtdurchmesser',dWires_G2 + write(lunTMP,1000) 'Drahtabstand',dist_Wires_G2 + trans = 1.-dWires_G2/dist_Wires_G2 + write(lunTMP,1000) '=> Transmission (Gitter 2)',trans + totTrans = totTrans * trans + endif + write(lunTMP,*) + write(lunTMP,*) 'He-Schild:' + write(lunTMP,*) '----------' + write(lunTMP,1000) 'Radius des He-Schildes',rHeShield + write(lunTMP,1000) 'Breite des Fensters',dyHeShield + write(lunTMP,1000) 'Hoehe des Fensters',dzHeShield + write(lunTMP,*) + write(lunTMP,*) 'LN-Schild:' + write(lunTMP,*) '----------' + write(lunTMP,1000) 'Radius des LN-Schildes',rLNShield + write(lunTMP,1000) 'Breite des Fensters',dyLNShield + write(lunTMP,1000) 'Hoehe des Fensters',dzLNShield + write(lunTMP,*) + write(lunTMP,*) 'Linse 1:' + write(lunTMP,*) '--------' + write(lunTMP,1001) 'MappenName',MappenName_L1 + write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_L1 + help = xCenterOfLense_L1-LengthOuterCyl_L1-DistanceCyl_L1-0.5*LengthInnerCyl_L1 + write(lunTMP,1000) 'Anfang der Linse',help + write(lunTMP,1000) 'Mitte der Linse',xCenterOfLense_L1 + help = xCenterOfLense_L1+LengthOuterCyl_L1+DistanceCyl_L1+0.5*LengthInnerCyl_L1 + write(lunTMP,1000) 'Ende der Linse',help + write(lunTMP,1000) 'Ende der Potentialmappe',xLeaveMap_L1 + write(lunTMP,1000) 'Laenge der auesseren Zylinder',LengthOuterCyl_L1 + write(lunTMP,1000) 'Laenge des inneren Zylinders',LengthInnerCyl_L1 + write(lunTMP,1000) 'Abstand der Zylinder',DistanceCyl_L1 + write(lunTMP,1000) 'Innenradius der Zylinder',iRadiusCyl_L1 + write(lunTMP,1000) 'Aussenradius der auesseren Zylinder',oRadiusOuterCyl_L1 + write(lunTMP,1000) 'Aussenradius des inneren Zylinders',oRadiusInnerCyl_L1 + write(lunTMP,*) + write(lunTMP,*) 'Spiegel:' + write(lunTMP,*) '--------' + write(lunTMP,1000) 'Spiegelaufhaengung',xSpiegel + if (.NOT.idealMirror) write(lunTMP,1001) 'MappenName',MappenName_Sp + write(lunTMP,1000) 'Laenge des Dreharmes',DreharmLaenge + write(lunTMP,1000) 'Spiegelbreite',BSpiegel + write(lunTMP,1000) 'Spiegelhoehe',hSpiegel + write(lunTMP,1000) 'Spiegeltiefe',DSpiegel + if (TestOnWireHit) then + write(lunTMP,1000) 'Drahtdurchmesser',dWires_Sp + write(lunTMP,1000) 'Drahtabstand',dist_Wires_Sp + trans = max(0.,1.-SQRT(2.)*dWires_Sp/dist_Wires_Sp) + ! max() wird benoetigt, da wegen Schraegstellung des Gitters + ! die Projektionen der Gitterstaebe ueberlappen koennen + trans = trans * trans ! Gitter wird zweimal durchquert + write(lunTMP,1000) '=> Spiegel-Transmission (2 Gitter)',trans + totTrans = totTrans * trans + endif + write(lunTMP,*) + if (lense2) then + write(lunTMP,*) 'Linse 2:' + write(lunTMP,*) '--------' + write(lunTMP,1001) 'MappenName',MappenName_L2andFo + write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_L2andFo + help = xCenterOfLense_L2-LengthOuterCyl_L2-DistanceCyl_L2-0.5*LengthInnerCyl_L2 + write(lunTMP,1000) 'Anfang der Linse',help + write(lunTMP,1000) 'Mitte der Linse',xCenterOfLense_L2 + help = xCenterOfLense_L2+LengthOuterCyl_L2+DistanceCyl_L2+0.5*LengthInnerCyl_L2 + write(lunTMP,1000) 'Ende der Linse',help + write(lunTMP,1000) 'Ende der Potentialmappe',xLeaveMap_L2andFo + write(lunTMP,1000) 'Laenge der auesseren Zylinder',LengthOuterCyl_L2 + write(lunTMP,1000) 'Laenge des inneren Zylinders',LengthInnerCyl_L2 + write(lunTMP,1000) 'Abstand der Zylinder',DistanceCyl_L2 + write(lunTMP,1000) 'Innenradius der Zylinder',iRadiusCyl_L2 + write(lunTMP,1000) 'Aussenradius der auesseren Zylinder',oRadiusOuterCyl_L2 + write(lunTMP,1000) 'Aussenradius des inneren Zylinders',oRadiusInnerCyl_L2 + write(lunTMP,*) + endif + if (TriggerInBeam) then + write(lunTMP,*) 'Trigger-Detektor (Werte fuer alpha(TD) = 0)' + write(lunTMP,*) '-------------------------------------------' + if (lense2) then + write(lunTMP,1001) 'mappenName','siehe Linse 2' + write(lunTMP,1001) 'Beginn der Potentialmappe','siehe Linse 2' + elseif (.NOT.gridInFrontOfFoil) then + write(lunTMP,1001) 'mappenName',mappenName_Fo + write(lunTMP,1000) 'Laenge der Mappe',mappenLaenge_Fo + write(lunTMP,1000) 'Beginn der Potentialmappe',xTD-d_Folie_Achse-mappenLaenge_Fo + write(lunTMP,1000) '''x_intersectTDMap''',x_intersectTDMap + write(lunTMP,1000) '''x_intersectTD''',x_intersectTD + endif + write(lunTMP,1000) 'x-Position der Triggerfolie',xTD-d_Folie_Achse + write(lunTMP,1000) 'x-Position der Aufhaengung',xTD + write(lunTMP,1000) 'x-Position von ''Ground''',xTD+dx3/2+dx4+dx5 + if (TestOnWireHit) then + help = 1 + write(lunTMP,1000) 'Fo: Transmission',TransTDFoil + write(lunTMP,1000) 'V1: Drahtdurchmesser',dWires_V1 + write(lunTMP,1000) ' Drahtabstand ',dist_Wires_V1 + trans = 1.-dWires_V1/dist_Wires_V1 + write(lunTMP,1000) ' => Transmission ',trans + help = help * trans + write(lunTMP,1000) 'V2: Drahtdurchmesser',dWires_V2 + write(lunTMP,1000) ' Drahtabstand ',dist_Wires_V2 + trans = max(0.,1.-SQRT(2.)*dWires_V2/dist_Wires_V2) + ! max() wird benoetigt, da wegen Schraegstellung des Gitters + ! die Projektionen der Gitterstaebe ueberlappen koennen + write(lunTMP,1000) ' => Transmission ',trans + help = help * trans + write(lunTMP,1000) 'V3: Drahtdurchmesser',dWires_V3 + write(lunTMP,1000) ' Drahtabstand ',dist_Wires_V3 + trans = 1.-dWires_V3/dist_Wires_V3 + write(lunTMP,1000) ' => Transmission ',trans + ! V3-Transmission geht nicht m+-Transmission ein! + write(lunTMP,1000) 'H1: Drahtdurchmesser',dWires_H1 + write(lunTMP,1000) ' Drahtabstand ',dist_Wires_H1 + trans = max(0.,1.-SQRT(2.)*dWires_H1/dist_Wires_H1) + ! max() wird benoetigt, da wegen Schraegstellung des Gitters + ! die Projektionen der Gitterstaebe ueberlappen koennen + write(lunTMP,1000) ' => Transmission ',trans + help = help * trans + write(lunTMP,1000) 'H2: Drahtdurchmesser',dWires_H2 + write(lunTMP,1000) ' Drahtabstand ',dist_Wires_H2 + trans = 1.-dWires_H2/dist_Wires_H2 + write(lunTMP,1000) ' => Transmission ',trans + help = help * trans + write(lunTMP,1000) 'G: Drahtdurchmesser',dWires_G + write(lunTMP,1000) ' Drahtabstand ',dist_Wires_G + trans = 1.-dWires_G/dist_Wires_G + write(lunTMP,1000) ' => Transmission ',trans + help = help * trans + write(lunTMP,*) + write(lunTMP,1000) 'totale TD-Transm. excl. Folie',help + write(lunTMP,1000) 'totale TD-Transm. incl. Folie',help*TransTDFoil + write(lunTMP,*) + totTrans = totTrans * help * transTDFoil + if (generate_FE) write(lunTMP,1000) 'MCP3-Effizienz',efficiencyM3 + endif + write(lunTMP,*) + endif + write(lunTMP,*) 'Linse 3:' + write(lunTMP,*) '------------' + write(lunTMP,1001) 'MappenName',MappenName_L3 + write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_L3 + help = xCenterOfLense_L3-LengthOuterCyl_L3-DistanceCyl_L3-0.5*LengthInnerCyl_L3 + write(lunTMP,1000) 'Anfang der Linse',help + write(lunTMP,1000) 'Mitte der Linse',xCenterOfLense_L3 + help = xCenterOfLense_L3+LengthOuterCyl_L3+DistanceCyl_L3+0.5*LengthInnerCyl_L3 + write(lunTMP,1000) 'Ende der Linse',help + write(lunTMP,1000) 'Ende der Potentialmappe',xLeaveMap_L3 + write(lunTMP,1000) 'Laenge der auesseren Zylinder',LengthOuterCyl_L3 + write(lunTMP,1000) 'Laenge des inneren Zylinders',LengthInnerCyl_L3 + write(lunTMP,1000) 'Abstand der Zylinder',DistanceCyl_L3 + write(lunTMP,1000) 'Innenradius der Zylinder',iRadiusCyl_L3 + write(lunTMP,1000) 'Aussenradius der auesseren Zylinder',oRadiusOuterCyl_L3 + write(lunTMP,1000) 'Aussenradius des inneren Zylinders',oRadiusInnerCyl_L3 + write(lunTMP,*) + write(lunTMP,*) 'MCP2:' + write(lunTMP,*) '-----' + write(lunTMP,1001) 'MappenName',MappenName_M2 + write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_M2 + if (xBlende.GT.0.) then + write(lunTMP,1000) 'x-Position der Blende',xBlende + write(lunTMP,1000) 'Radius der Blende',radius_Blende + endif + write(lunTMP,1000) 'x-Position des MCP2',xMCP2 + write(lunTMP,1000) 'Radius des MCP2',radius_MCP2 + write(lunTMP,1000) 'Radius der aktiven Flaeche',radius_MCP2active + write(lunTMP,*) + if (TestOnWireHit) then + write(lunTMP,*) + write(lunTMP,1000) 'PRODUKT ALLER GITTERTRANSMISSIONEN',totTrans + if (TriggerInBeam) then + write(lunTMP,'(4x,A,F5.1,A)') '(bei Transmission des TD-Folien-Stuetzgitters von ',100*TransTDFoil,'%)' + endif + write(lunTMP,*) + endif + close(lunTMP) + +1000 format(4x,A,T40,'= ',F8.3) +1001 format(4x,A,T40,': ',A) + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_INFOFILE +c ======================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + integer i,j + + integer pos_Anzahl + parameter (pos_Anzahl = 20) + + integer pos(pos_Anzahl) /UTgt,UGua,UG1, UL1,USp,UL2, + + UFolie, BHelm,BTD, + + alfTgt,alfSp,alfTD, mass,charge, + + ener,yPos,zPos,thetAng,phiAng,DeltaL1 / + + character*8 label(pos_Anzahl) + DATA label / + + 'U_Tgt_ ','U_Gua_ ','U_G1_ ','U_L1_ ','U_Sp_ ','U_L2_ ', + + 'U_Folie_','B_Helm_ ','B_TD_ ', + + 'alfaTgt_','alfaSp_ ','alfaTD_ ','Masse_ ','Ladung_ ', + + 'E0_ ','y0_ ','z0_ ','theta0_ ','phi0_ ','DeltaL1_'/ + + integer par_,nr + integer help_reihenfolge(pos_Anzahl) + +c------------------------------------------------------------------------------- + +c Gegebenenfalls schreiben des Files mit den E0-Intervallen: + + if (E0InterFromFile) then + open (lunFOIL,file=fileName,defaultfile=outDir//':.E0',status='NEW') + do i = 1, n_par(ener) + write (lunFOIL,1000) 100+i,nint(1000.*E0Low(i)),nint(1000.*E0Low(i+1)) + enddo + close (lunFOIL) + endif +1000 format(x,I4,8x,I5,5x,I5,8x,I7) + + +c fill 'help_reihenfolge': +c falls 'reihenfolge(i)' auch in 'pos' enthalten ist, uebernehme es in +c 'help_reihenfolge': + + nr = 0 + do i = 1, par_Anzahl + par_ = reihenfolge(i) + do j = 1, pos_Anzahl + if (par_.EQ.pos(j)) then + nr = nr + 1 + help_reihenfolge(nr) = par_ + endif + enddo + enddo + if (Nr.NE.pos_Anzahl) then + write(*,*)' error xxx' + call exit + endif + + +c open INFO file: + + open (lunFOIL,file=fileName,defaultfile=outDir//':.INFO',status='NEW') + + +c output information: + + write (lunFOIL,*)'========================================'// + + '========================================' + write(lunFOIL,*)' This file contains the input parameters used for '//filename + write (lunFOIL,*)'========================================'// + + '========================================' + write (lunFOIL,*)' The following parameters are the ones relevant for further' + write (lunFOIL,*)' calculations by MUTRACK:' + write (lunFOIL,*) + write (lunFOIL,*) '$muVersion' + write (lunFOIL,2600) 'mutrackVersion',Version + if (AccelVersion.NE.' ') write (lunFOIL,2600) 'accelVersion',accelVersion + write (lunFOIL,*) '$END' + write (lunFOIL,*) + write (lunFOIL,*) '$loop_params' + do j = 1, pos_Anzahl + par_ = pos(j) + if ((par_.EQ.mass.OR.par_.EQ.charge).AND.artList_defined) then + ! keine Ausgabe + elseif (par_.EQ.UGua. AND. .NOT.guard) then + ! keine Ausgabe + elseif ((par_.EQ.BHelm .OR. par_.EQ.BTD) .AND. + + par(1,par_).EQ.0. .AND. n_par(par_).LE.1) then + ! keine Ausgabe + elseif (par_.EQ.UL2 .AND. .NOT.lense2) then + ! keine Ausgabe + else + if (n_par(par_).LE.1) then + write (lunFOIL,*) ' ',label(j),' = ',par(1,par_) + elseif (n_par(par_).EQ.2) then + write (lunFOIL,*) ' ',label(j),' = ',(par(i,par_),i=1,2) + else + write (lunFOIL,*) ' ',label(j),' = ',(par(i,par_),i=1,3) + endif + endif + enddo + write (lunFOIL,*) '$END' + write (lunFOIL,*) + write (lunFOIL,*) '$additionals' + write (lunFOIL,2601) 'par_Anzahl_prevSim',pos_Anzahl + write (lunFOIL,2610) 'reihenFolge_prevSim',help_reihenfolge + if (USE_ACCEL) write (lunFOIL,2600) 'mappenNameACCEL',mappenNameACCEL +2610 format(3x,A,T25,'= ',30(x,I2,:)) + if (artList_defined) write (lunFOIL,2601) 'artenZahl_prevSim',n_par(charge) + write (lunFOIL,*) '$END' + write (lunFOIL,*) + write (lunFOIL,*) '$parameter_liste' + write (lunFOIL,*) + write (lunFOIL,2601) 'Startflaeche',Startflaeche + if (startFlaeche.EQ.-1) then + write(lunFOIL,2602)'x0_',x0(1) +c write(lunFOIL,2601)'Kammerteil',Kammerteil + endif + write (lunFOIL,*) + if (artList_defined) then + write (lunFOIL,2600) 'artList_prevSim',artlist + else + write (lunFOIL,*) 'artList_prevSim' + endif + write (lunFOIL,2603) 'UseDecay_prevSim',UseDecay + write (lunFOIL,*) + write (lunFOIL,2601) 'randomStarts_prevSim',n_par(0) + if (random_E0) then + if (random_E0_equal) then + write(lunFOIL,2601)'random_energy',1 + if (E0InterFromFile) write (lunFOIL,2603) 'E0InterFromFile',E0InterFromFile + write(lunFOIL,2602)'lowerE0',lowerE0 + write(lunFOIL,2602)'upperE0',upperE0 + elseif (random_E0_gauss) then + write(lunFOIL,2601)'random_energy',2 + write(lunFOIL,2602)'sigmaE0',sigmaE0 + endif + else + write(lunFOIL,2601)'random_energy',0 + endif + if (random_pos) then + if (random_y0z0_equal) then + write(lunFOIL,2601)'random_position',1 + write(lunFOIL,2602)'StartBreite',StartBreite + write(lunFOIL,2602)'StartHoehe',StartHoehe + elseif (random_r0_equal) then + write(lunFOIL,2601)'random_position',2 + write(lunFOIL,2602)'StartRadius',StartRadius + elseif (random_y0z0_Gauss) then + write(lunFOIL,2601)'random_position',3 + write(lunFOIL,2602)'StartBreite',StartBreite + write(lunFOIL,2602)'StartHoehe',StartHoehe + write(lunFOIL,2602)'sigmaPosition',sigmaPosition + elseif (random_r0_Gauss) then + write(lunFOIL,2601)'random_position',4 + write(lunFOIL,2602)'StartRadius',StartRadius + write(lunFOIL,2602)'sigmaPosition',sigmaPosition + endif + else + write(lunFOIL,2601)'random_position',0 + endif + if (random_angle) then + if (random_lambert) then + write(lunFOIL,2601)'random_winkel',1 + write(lunFOIL,2602)'StartLambertOrd',StartLambertOrd + elseif (random_gauss) then + write(lunFOIL,2601)'random_winkel',2 + write(lunFOIL,2602)'sigmaWinkel',sigmaWinkel + endif + else + write(lunFOIL,2601)'random_winkel',0 + endif + + write (lunFOIL,*) + write (lunFOIL,2603) 'TriggerInBeam',TriggerInBeam + write (lunFOIL,2603) 'GridInFrontOfFoil',GridInFrontOfFoil + write (lunFOIL,2603) 'TestOnWireHit',TestOnWireHit + if (Use_ACCEL) then + write (lunFOIL,2601) 'previousSimulation',1 + write (lunFOIL,2600) 'fileName_ACCEL',fileName_ACCEL + endif + write (lunFOIL,2603) 'idealMirror',idealMirror + write (lunFOIL,*) + if (alfaTgtVertically) then + write (lunFOIL,2603) 'alfaTgtVertically',alfaTgtVertically + write (lunFOIL,*) + endif + + write (lunFOIL,*) '$END' + + write (lunFOIL,*) + write (lunFOIL,*)'========================================'// + + '========================================' + write (lunFOIL,*) + write (lunFOIL,*) '$kammer_geo' + write (lunFOIL,*) + write (lunFOIL,2602) 'radius_Rohr ', radius_Rohr + write (lunFOIL,2602) 'xtarget ', xtarget + write (lunFOIL,2602) 'dytarget ', dytarget + write (lunFOIL,2602) 'dztarget ', dztarget + write (lunFOIL,2602) 'xgrid1 ', xgrid1 + write (lunFOIL,2602) 'dygrid1 ', dygrid1 + write (lunFOIL,2602) 'dzgrid1 ', dzgrid1 + if (TestOnWireHit.OR.Use_ACCEL) then + write (lunFOIL,2602) 'dist_wires_G1 ', dist_wires_G1 + write (lunFOIL,2602) 'dWires_G1 ', dWires_G1 + endif + write (lunFOIL,2602) 'xgrid2 ', xgrid2 + write (lunFOIL,2602) 'dygrid2 ', dygrid2 + write (lunFOIL,2602) 'dzgrid2 ', dzgrid2 + if (TestOnWireHit.OR.Use_ACCEL) then + write (lunFOIL,2602) 'dist_wires_G2 ', dist_wires_G2 + write (lunFOIL,2602) 'dWires_G2 ', dWires_G2 + endif + write (lunFOIL,2602) 'rHeShield ', rHeShield + write (lunFOIL,2602) 'dyHeShield ', dyHeShield + write (lunFOIL,2602) 'dzHeShield ', dzHeShield + write (lunFOIL,2602) 'rLNShield ', rLNShield + write (lunFOIL,2602) 'dyLNShield ', dyLNShield + write (lunFOIL,2602) 'dzLNShield ', dzLNShield + write (lunFOIL,2602) 'xCenterOfLense_L1 ', xCenterOfLense_L1 + write (lunFOIL,2600) 'MappenName_L1 ', MappenName_L1 + write (lunFOIL,2602) 'xSpiegel ', xSpiegel + if (.NOT.idealMirror) write (lunFOIL,2600) 'MappenName_Sp ', MappenName_Sp + write (lunFOIL,2602) 'DreharmLaenge ', DreharmLaenge + write (lunFOIL,2602) 'BSpiegel ', BSpiegel + write (lunFOIL,2602) 'hSpiegel ', hSpiegel + write (lunFOIL,2602) 'DSpiegel ', DSpiegel + if (TestOnWireHit) then + write (lunFOIL,2602) 'dist_wires_Sp ', dist_wires_Sp + write (lunFOIL,2602) 'dWires_Sp ', dWires_Sp + endif + if (lense2) then + write (lunFOIL,2602) 'xCenterOfLense_L2 ', xCenterOfLense_L2 + write (lunFOIL,2602) 'xTD ', xTD + write (lunFOIL,2600) 'MappenName_L2andFo', MappenName_L2andFo + else + write (lunFOIL,2602) 'xTD ', xTD + write (lunFOIL,2600) 'mappenName_Fo ', mappenName_Fo + endif + write (lunFOIL,*) + write (lunFOIL,*) '$END' + write (lunFOIL,*) + write (lunFOIL,*)'========================================'// + + '========================================' + if (E0InterFromFile) then + write (lunFOIL,*) 'Boundaries of E0-Intervalls:' + do i = 1, n_par(ener)+1 + write (lunFOIL,'(4x,F8.3)') E0Low(i) + enddo + write (lunFOIL,*)'========================================'// + + '========================================' + endif + + +2600 format(3x,A,T25,'= ':'''',A,'''') ! fuer character +2601 format(3x,A,T25,'= ',4x,I8) ! fuer integer +2602 format(3x,A,T25,'= ',F12.6) ! fuer real +2603 format(3x,A,T25,'= ',L12) ! fuer logical +2604 format(3x,A,T25,'= ',E12.6) ! fuer Exponentdarstellung + + +c close INFO file: + + close (lunFOIL) + + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_PICTURE.FOR b/mutrack/src/SUB_PICTURE.FOR new file mode 100644 index 0000000..2c6bc10 --- /dev/null +++ b/mutrack/src/SUB_PICTURE.FOR @@ -0,0 +1,1842 @@ + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MASSTAB_SETZEN +C ========================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + logical BATCH_MODE + COMMON /BATCH_MODE/ BATCH_MODE + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory ! Der Arbeitsbereich fuer HBOOK + + +c Initialisierungen vornehmen: + +c CALL HLIMIT(HB_memsize) ! Speichergroesse uebermitteln (nicht schon in MUTRACK?) + + 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. + + if (.NOT.batch_mode) then + CALL IOPWK(1,11,1) ! open WS for 'CHAM_1' + CALL IOPWK(3,21,2) ! open WS for 'CHAM_2' + CALL IOPWK(4,31,3) ! open WS for 'HISTO' + CALL IOPWK(5,41,4) ! open WS for 'TEXT' + endif + + +c Farbtafeln fuer WS 1 'CHAM_1' setzen: + + call iscr(1,0,1.,1.,1.) + call iscr(1,1,0.,0.,0.) + call iscr(1,2,1.,0.,0.) + call iscr(1,3,1.,0.5,0.) + call iscr(1,4,0.,1.,0.) + call iscr(1,5,0.,1.,1.) + call iscr(1,6,0.,0.,1.) + call iscr(1,7,1.,0.,1.) + + +c Farbtafeln fuer WS 2 'CHAM_2' setzen: + + call iscr(2,0,1.,1.,1.) + call iscr(2,1,0.,0.,0.) + call iscr(2,2,1.,0.,0.) + call iscr(2,3,1.,0.5,0.) + call iscr(2,4,0.,1.,0.) + call iscr(2,5,0.,1.,1.) + call iscr(2,6,0.,0.,1.) + call iscr(2,7,1.,0.,1.) + + +c Masstaebe definieren: + +c - Transformationsindex 1 fuer 'CHAM_1': + +c CALL ISVP(5,0.,1.,0.,1.) ! viewport boundaries +c CALL ISWN(5,-rLNShield-10.,600.,-100.,100.) ! window boundaries +cc CALL ISWN(5,-rLNShield-50.,xSpiegel+200.,-70.,50.) ! window boundaries +cc CALL ISWN(5,-rLNShield-50.,xSpiegel+200.,-dy_Graph1-20.,dy_Graph1) + +c - Transformationsindex 2 fuer 'CHAM_2': + +c CALL ISVP(2,0.,1.,0.,1.) ! viewport boundaries +c CALL ISWN(2,-60.,xMCP2+200.,-70.,50.) ! window boundaries +cc CALL ISWN(2,-60.,xMCP2+200.,-dy_Graph2-20.,dy_Graph2) + +c - Transformationsindex 3 fuer 'TEXT': + +c CALL ISVP(3,0.,1.,0.,1.) ! viewport boundaries +c CALL ISWN(3,0.,100.,0.,100.) ! window boundaries + + +c alte Version: + + CALL ISWN(2,-60.,xMCP2+200.,-70.,50.) ! MASSTAB SETZEN +c CALL ISWN(2,-60.,1300.,-70.,50.) ! MASSTAB SETZEN + CALL ISVP(2,0.,1.,0.,1.) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PLOT_CHAMBER(schnitt_p) +C ================================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + logical lense2 + common /lense2/ lense2 + + real alfa_window + real dxTarget /10./ + + real x1,x2,ri,ro + real x(9),y(9) + + integer SCHNITT_P, COLOR + real SCHNITT_X + logical VERTICAL + COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL + + logical TriggerInBeam + COMMON /TRIGGERINBEAM/ TriggerInBeam + + logical BATCH_MODE + COMMON /BATCH_MODE/ BATCH_MODE + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + COMMON /pawc/ memory + + real help + + +c=============================================================================== +c 1. Kammerteil zeichnen: +c=============================================================================== + +c Picture waehlen: + + CALL IZPICT('CHAM_1','C') ! make 'CHAM_1' the currrent picture +c CALL ISELNT(5) ! Masstab '1' aktivieren + CALL ISELNT(2) ! Masstab '2' aktivieren + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Marker fuer Schnittebene plazieren: + + call ISMK (23) ! Markertyp fuer Schnittebenenmarkierung waehlen + if (schnitt_p.eq.1) call IPM(1,SCHNITT_X,45.) ! 45: y-POS. DES MARKERS + + +c Zeichne Achsen: + +c - x-ACHSE: + CALL IGAXIS (0.,xSpiegel+130.,-60.,-60.,0.,xSpiegel+130.,20,'O+') + +c - y-ACHSE: + CALL IGAXIS (xSpiegel+130.,xSpiegel+130.,-60.,40.,-60.,40.,20,'O+') + + + if (.NOT.vertical) goto 4321 +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c VERTIKALE DRAUFSICHT: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Zeichne aus Boxen bestehende Elemente: + +c Box um 1. Kammerteil: + + CALL IGBOX(-rLNShield-20.,xSpiegel+256.,-70.,50.) + + +c Moderator: + + CALL IGBOX(xTarget-dxTarget,xTarget,-dyTarget/2.,+dyTarget/2.) + + +c Linse 1: + + ri = iRadiusCyl_L1 ! Innenradius + +c - 1. Zylinder: + + ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1-LengthOuterCyl_L1 + x2 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 2. Zylinder: + + ro = oRadiusInnerCyl_L1 ! Aussenradius des inneren Zylinders + x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1 + x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 3. Zylinder: + + ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1 + x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1+LengthOuterCyl_L1 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit durchgezogenen Linien: + + CALL ISLWSC(4.) ! LINIENDICKE: moderat + CALL ISLN(1) ! LINIENTYP: durchgezogen + + +c He-Schirm: + + alfa_window = asind(.5*dyHeShield/rHeShield) + CALL IGARC (0.,0.,rHeShield,rHeShield+2.,alfa_window,360.-alfa_window) + + +c LN-Schirm: + + alfa_window = asind(.5*dyLNShield/rLNShield) + CALL IGARC (0.,0.,rLNShield,rLNShield+2.,alfa_window,360.-alfa_window) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit gepunkteten Linien: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + +c Beschleuniger: + +c - 1. Gitter: + + X(1)= xGrid1 + Y(1)= dyGrid1/2. + X(2)= X(1) + Y(2)=-Y(1) + CALL IPL (2,X,Y) + +c - 2. Gitter: + + X(1)= xGrid2 + Y(1)= dyGrid2/2. + X(2)= X(1) + Y(2)=-Y(1) + CALL IPL (2,X,Y) + + +c Spiegel: + + +c - 1. Gitter: + + help = DreharmLaenge + dSpiegel/2 + + x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + y(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + y(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + CALL IPL (2,X,Y) + + +c - Mittelebene: + + help = DreharmLaenge + + x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + y(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + y(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + CALL IPL (2,X,Y) + + +c - 2. Gitter: + + help = DreharmLaenge - dSpiegel/2 + + x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + y(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + y(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + CALL IPL (2,X,Y) + + + goto 4322 +4321 continue +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c HORIZONTALE DRAUFSICHT: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Zeichne aus Boxen bestehende Elemente: + +c Box um 1. Kammerteil: + + CALL IGBOX(-rLNShield-20.,xSpiegel+256.,-70.,50.) + + +c Moderator: + + CALL IGBOX (xTarget-dxTarget,xTarget,-dzTarget/2.,+dzTarget/2.) + + +c Linse 1: + + ri = iRadiusCyl_L1 ! Innenradius + +c - 1. Zylinder: + + ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1-LengthOuterCyl_L1 + x2 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 2. Zylinder: + + ro = oRadiusInnerCyl_L1 ! Aussenradius des inneren Zylinders + x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1 + x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 3. Zylinder: + + ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1 + x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1+LengthOuterCyl_L1 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit durchgezogenen Linien: + + CALL ISLWSC(4.) ! LINIENDICKE: moderat + CALL ISLN(1) ! LINIENTYP: durchgezogen + + +c He-Schirm: + + alfa_window = asind(.5*dyHeShield/rHeShield) + x(1) = -rHeShield + x(2) = +rHeShield + x(3) = +rHeShield + x(4) = rHeShield*cosd(alfa_window) + x(5) = x(4) + x(6) = +rHeShield + x(7) = +rHeShield + x(8) = -rHeShield + x(9) = -rHeShield + + y(1) = -1.3*dzHeShield/2. + y(2) = -1.3*dzHeShield/2. + y(3) = -dzHeShield/2. + y(4) = -dzHeShield/2. + y(5) = +dzHeShield/2. + y(6) = +dzHeShield/2. + y(7) = +1.3*dzHeShield/2. + y(8) = +1.3*dzHeShield/2. + y(9) = -1.3*dzHeShield/2. + + call IPL(9,x,y) + + +c LN-Schirm: + + alfa_window = asind(.5*dyLNShield/rLNShield) + x(1) = -rLNShield + x(2) = +rLNShield + x(3) = +rLNShield + x(4) = rLNShield*cosd(alfa_window) + x(5) = x(4) + x(6) = +rLNShield + x(7) = +rLNShield + x(8) = -rLNShield + x(9) = -rLNShield + + y(1) = -1.3*dzLNShield/2. + y(2) = -1.3*dzLNShield/2. + y(3) = -dzLNShield/2. + y(4) = -dzLNShield/2. + y(5) = +dzLNShield/2. + y(6) = +dzLNShield/2. + y(7) = +1.3*dzLNShield/2. + y(8) = +1.3*dzLNShield/2. + y(9) = -1.3*dzLNShield/2. + + call IPL(9,x,y) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit gepunkteten Linien: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + +c Beschleuniger: + +c - 1. Gitter: + + X(1)= xGrid1 + Y(1)= dzGrid1/2. + X(2)= X(1) + Y(2)=-Y(1) + CALL IPL (2,X,Y) + +c - 2. Gitter: + + X(1)= xGrid2 + Y(1)= dzGrid2/2. + X(2)= X(1) + Y(2)=-Y(1) + CALL IPL (2,X,Y) + + +c Spiegel: + + y(1) = hSpiegel/2. + y(2) = -y(1) + +c - 1. Gitter: + + help = DreharmLaenge + dSpiegel/2 + + x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + x(1) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + + +cc - Mittelebene: +c +c help = DreharmLaenge +c +c x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp +c x(2) = x(1) +c CALL IPL (2,X,Y) +c x(1) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp +c x(2) = x(1) +c CALL IPL (2,X,Y) + + +c - 2. Gitter: + + help = DreharmLaenge - dSpiegel/2 + + x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + x(1) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Picture 'CHAM_1' auf WS 1 ausgeben: + +4322 continue + + if (.NOT.batch_mode) then + CALL IACWK(1) ! aktiviere WS 1 + CALL IZPICT('CHAM_1','D') ! display 'CHAM_1' + CALL IGTERM ! update open WS and return to + ! alfanumeric mode + CALL IDAWK(1) ! deaktiviere WS 1 + endif + + +c=============================================================================== +c 2. Kammerteil zeichnen: +c=============================================================================== + +c Picture waehlen: + + CALL IZPICT('CHAM_2','C') ! make 'CHAM_2' the currrent picture + CALL ISELNT(2) ! Masstab '2' aktivieren + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Marker fuer Schnittebene plazieren: + + if (schnitt_p.eq.2) call IPM(1,SCHNITT_X,45.) ! 45: y-POS. DES MARKERS + + +c Zeichne Achsen: + +c CALL IGAXIS (0.,1180.,-60.,-60.,0.,1180.,40,'O+') ! X-ACHSE +c CALL IGAXIS (1180.,1180.,-60.,40.,-60.,40.,20,'O+') ! Y-ACHSE + + CALL IGAXIS (0.,xMCP2+80.,-60.,-60.,0.,xMCP2+80.,40,'O+') ! X-ACHSE + CALL IGAXIS (xMCP2+80.,xMCP2+80.,-60.,40.,-60.,40.,20,'O+') ! Y-ACHSE + + + if (.NOT.vertical) goto 4323 +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c VERTIKALE DRAUFSICHT: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Zeichne aus Boxen bestehende Elemente: + +c Box um 2. Kammerteil: + + CALL IGBOX(-60.,xMCP2+200.,-70.,50.) +c CALL IGBOX(-60.,1300.,-70.,50.) + + +c Linse 2: + + if (lense2) then + + ri = iRadiusCyl_L2 ! Innenradius + +c - 1. Zylinder: + + ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2-LengthOuterCyl_L2 + x2 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 2. Zylinder: + + ro = oRadiusInnerCyl_L2 ! Aussenradius des inneren Zylinders + x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2 + x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 3. Zylinder: + + ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2 + x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2+LengthOuterCyl_L2 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + + endif + + +c Linse 3: + + ri = iRadiusCyl_L3 ! Innenradius + +c - 1. Zylinder: + + ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3-LengthOuterCyl_L3 + x2 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 2. Zylinder: + + ro = oRadiusInnerCyl_L3 ! Aussenradius des inneren Zylinders + x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3 + x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 3. Zylinder: + + ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3 + x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3+LengthOuterCyl_L3 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit durchgezogenen Linien: + + CALL ISLWSC(4.) ! LINIENDICKE: moderat + CALL ISLN(1) ! LINIENTYP: durchgezogen + +c Blende: + + if (xBlende.GT.0) then + X(1)= xBlende + Y(1)= radius_Blende + X(2)= xBlende + Y(2)= 40 + CALL IPL (2,X,Y) + Y(1)= -Y(1) + Y(2)= -Y(2) + CALL IPL (2,X,Y) + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit gepunkteten Linien: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + +c Spiegel: + +c - 1. Gitter: + + help = DreharmLaenge + dSpiegel/2 + + x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + y(1) = - bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp + y(2) = + bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp + CALL IPL (2,X,Y) + +c - Mittelebene: + + help = DreharmLaenge + + x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + y(1) = - bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp + y(2) = + bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp + CALL IPL (2,X,Y) + +c - 2. Gitter: + + help = DreharmLaenge - dSpiegel/2 + + x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + y(1) = - bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp + y(2) = + bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp + CALL IPL (2,X,Y) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit gemischten Linientypen und -staerken: + + +c Triggerdetektor: + + IF (TriggerInBeam) CALL PLOT_TD + + +c MCP2: + + CALL ISLWSC(2.) ! LINIENDICKE: duenn + CALL ISLN(1) ! LINIENTYP: durchgezogen + +c CALL ISFASI(152) ! select FILL AREA INTERIOR STYLE +c CALL ISFAIS(3) ! fill with FILL AREA INTERIOR STYLE + CALL IGBOX (xMCP2,xMCP2+10.,radius_MCP2active,-radius_MCP2active) + +c CALL ISFASI(0) ! select FILL AREA INTERIOR STYLE +c CALL ISFAIS(0) ! do not fill + CALL IGBOX (xMCP2,xMCP2+10., radius_MCP2, radius_MCP2active) + CALL IGBOX (xMCP2,xMCP2+10.,-radius_MCP2,-radius_MCP2active) + + + goto 4324 +4323 continue +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c HORIZONTALE DRAUFSICHT: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Zeichne aus Boxen bestehende Elemente: + +c Box um 2. Kammerteil: + + CALL IGBOX(-60.,xMCP2+200.,-70.,50.) +c CALL IGBOX(-60.,1300.,-70.,50.) + + +c Linse 2: + + if (lense2) then + + ri = iRadiusCyl_L2 ! Innenradius + +c - 1. Zylinder: + + ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2-LengthOuterCyl_L2 + x2 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 2. Zylinder: + + ro = oRadiusInnerCyl_L2 ! Aussenradius des inneren Zylinders + x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2 + x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 3. Zylinder: + + ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2 + x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2+LengthOuterCyl_L2 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + + endif + + +c Linse 3: + + ri = iRadiusCyl_L3 ! Innenradius + +c - 1. Zylinder: + + ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3-LengthOuterCyl_L3 + x2 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 2. Zylinder: + + ro = oRadiusInnerCyl_L3 ! Aussenradius des inneren Zylinders + x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3 + x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + +c - 3. Zylinder: + + ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder + x1 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3 + x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3+LengthOuterCyl_L3 + CALL IGBOX (x1,x2, ri, ro) + CALL IGBOX (x1,x2,-ri,-ro) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit durchgezogenen Linien: + + CALL ISLWSC(4.) ! LINIENDICKE: moderat + CALL ISLN(1) ! LINIENTYP: durchgezogen + +c Blende: + + if (xBlende.GT.0) then + X(1)= xBlende + Y(1)= radius_Blende + X(2)= xBlende + Y(2)= 40 + CALL IPL (2,X,Y) + Y(1)= -Y(1) + Y(2)= -Y(2) + CALL IPL (2,X,Y) + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit gepunkteten Linien: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + +c Spiegel: + + y(1) = hSpiegel/2. + y(2) = -y(1) + +c - 1. Gitter: + + help = DreharmLaenge + dSpiegel/2 + + x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + x(1) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + + +cc - Mittelebene: +c +c help = DreharmLaenge +c +c x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp +c x(2) = x(1) +c CALL IPL (2,X,Y) +c x(1) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp +c x(2) = x(1) +c CALL IPL (2,X,Y) + +c - 2. Gitter: + + help = DreharmLaenge - dSpiegel/2 + + x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + x(1) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp + x(2) = x(1) + CALL IPL (2,X,Y) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Zeichne Elemente mit gemischten Linientypen und -staerken: + + +c Triggerdetektor: + + IF (TriggerInBeam) CALL PLOT_TD_HOR + + +c MCP2: + + CALL ISLWSC(2.) ! LINIENDICKE: duenn + CALL ISLN(1) ! LINIENTYP: durchgezogen + +c CALL ISFASI(152) ! select FILL AREA INTERIOR STYLE +c CALL ISFAIS(3) ! fill with FILL AREA INTERIOR STYLE + CALL IGBOX (xMCP2,xMCP2+10.,radius_MCP2active,-radius_MCP2active) + +c CALL ISFASI(0) ! select FILL AREA INTERIOR STYLE +c CALL ISFAIS(0) ! do not fill + CALL IGBOX (xMCP2,xMCP2+10., radius_MCP2, radius_MCP2active) + CALL IGBOX (xMCP2,xMCP2+10.,-radius_MCP2,-radius_MCP2active) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Picture 'CHAM_2' auf WS 3 ausgeben: + +4324 continue + + if (.NOT.batch_mode) then + CALL IACWK(3) ! aktiviere WS 3 + CALL IZPICT('CHAM_2','D') ! display 'CHAM_2' + CALL IGTERM ! update open WS and return to + ! alfanumeric mode + CALL IDAWK(3) ! deaktiviere WS 3 + endif + + +c Linientyp fuer die Trajektorien setzen: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(1) ! LINIENTYP: durchgezogen + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PLOT_TD +C ================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + logical gridInFrontOfFoil + common /foilGrid/ gridInFrontOfFoil + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + COMMON /pawc/ memory + + real x(5),y(5),z(5) + COMMON /trans_koord/ x,y,z + + real pi + parameter (pi = 3.1415927) + + real DM3 + real XTRS,XTRG1,XTRG2,XTRG3,XM3A,XM3E + real YTRF,YTRG1,YTRG2,YTRG3,YM3,ATRS,DTRS,LTRS + real P1X,P1Y,P2X,P2Y,P3X,P3Y,P4X,P4Y + + +c folgende x-Positionen sind relativ zur Triggerfolie: + + xtrs = 52 ! x-Koordinate des Triggerspiegels + xtrg1 = 8 ! x-Koordinate des i. Gitters + xtrg2 = 101 ! dto + xtrg3 = 101+dx5 ! dto + xm3a = 31 ! Anfang des MCP3 + xm3e = 73 ! Ende des MCP3 + ytrf = 30 ! sym. y-Ausdehnung der Triggerfolie + ytrg1 = 30 ! sym. y-Ausdehnung des i. Gitters + ytrg2 = 30 ! dto + ytrg3 = 30 ! dto + ym3 = -53 ! Abstand des MCP3 von der optischen Achse + DM3 = 2 ! DICKE VOM MCP3 + atrs = 135 ! (Grad)Drehwinkel des Triggerspiegels um die z-Achse + dtrs = 10 ! Abstand der Triggerspiegelebenen + ltrs = 80 ! Laenge des Triggerspiegels + +c Folie: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + x(1) = 0. + x(2) = 0. + y(1) = -SQRT(radiusQuad_Folie) + y(2) = +SQRT(radiusQuad_Folie) + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + CALL ISLWSC(2.) ! LINIENDICKE: duenn + CALL ISLN(1) ! LINIENTYP: durchgezogen + + x(1) = 0. + x(2) = 0. + y(1) = +SQRT(radiusQuad_Folie) + y(2) = YTRF + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + x(1) = 0. + x(2) = 0. + y(1) = -YTRF + y(2) = -SQRT(radiusQuad_Folie) + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + +c Gitterebenen: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + +c - Massegitter vor Folie: + + if (gridInFrontOfFoil) then +c if (dx5.NE.8) then + x(1) = - d_grid_folie + x(2) = - d_grid_folie + y(1) = YTRF + y(2) = -YTRF + + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + endif + + +c - forderes Gitter von VORNE: + + x(1) = XTRG1 + x(2) = XTRG1 + y(1) = YTRG1 + y(2) = -YTRG1 + + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + +c - hinteres Gitter von HINTEN: + + x(1) = XTRG2 + x(2) = XTRG2 + y(1) = YTRG2 + y(2) = -YTRG2 + + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + +c - geerdetes Gitter (GROUND): + + x(1) = XTRG3 + x(2) = XTRG3 + y(1) = YTRG3 + y(2) = -YTRG3 + + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + +c Spiegelgitter: + + P2X = (DTRS/2)*COS((PI/2)-(ATRS/180)*PI) + P2Y = -(DTRS/2)*SIN((PI/2)-(ATRS/180)*PI) + P1X = -P2X + P1Y = -P2Y + P3X = (LTRS/2)*cos((ATRS/180)*PI) + P3Y = (LTRS/2)*sin((ATRS/180)*PI) + P4X = -P3X + P4Y = -P3Y + + +cc Spiegelmittelebene: +c +c x(1) = p3x+xTRs +c x(2) = p4x+xTRs +c y(1) = p3y +c y(2) = p4y +c +c CALL KOORD_TRANSFORMATION(2) +c CALL IPL(2,x,y) + + +c forderes Spiegelgitter: + + X(1) = P3X+P1X+XTRS + X(2) = P4X+P1X+XTRS + Y(1) = P3Y+P1Y + Y(2) = P4Y+P1Y + + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + +c hinteres Spiegelgitter: + + X(1) = P3X+P2X+XTRS + X(2) = P4X+P2X+XTRS + Y(1) = P3Y+P2Y + Y(2) = P4Y+P2Y + + CALL KOORD_TRANSFORMATION(2) + CALL IPL(2,X,Y) + + +c MCP3: + + CALL ISLWSC(3.) ! LINIENDICKE: moderat + CALL ISLN(1) ! LINIENTYP: durchgezogen + + x(1) = xM3A + x(2) = xM3E + x(3) = xM3E + x(4) = xM3A + x(5) = xM3A + y(1) = yM3 + y(2) = yM3 + y(3) = yM3-dM3 + y(4) = yM3-dM3 + y(5) = yM3 + + CALL KOORD_TRANSFORMATION(5) + CALL IPL(5,X,Y) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PLOT_TD_HOR +C ====================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + logical gridInFrontOfFoil + common /foilGrid/ gridInFrontOfFoil + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + COMMON /pawc/ memory + + real x(5),y(5),z(5) + COMMON /trans_koord/ x,y,z + + real pi + parameter (pi = 3.1415927) + + real DM3 + real XTRS,XTRG1,XTRG2,XTRG3,XM3A,XM3E + real YTRF,YTRG1,YTRG2,YTRG3,YM3,ATRS,DTRS,LTRS + real P1X,P1Y,P2X,P2Y,P3X,P3Y,P4X,P4Y + real dz_half + + real xx(2) + +c folgende x-Positionen sind relativ zur Triggerfolie: + + xtrs = 52 ! x-Koordinate des Triggerspiegels + xtrg1 = 8 ! x-Koordinate des i. Gitters + xtrg2 = 101 ! dto + xtrg3 = 101+dx5 ! dto + xm3a = 31 ! Anfang des MCP3 + xm3e = 73 ! Ende des MCP3 + ytrf = 30 ! sym. y-Ausdehnung der Triggerfolie + ytrg1 = 30 ! sym. y-Ausdehnung des i. Gitters + ytrg2 = 30 ! dto + ytrg3 = 30 ! dto + ym3 = -53 ! Abstand des MCP3 von der optischen Achse + DM3 = 2 ! DICKE VOM MCP3 + atrs = 135 ! (Grad)Drehwinkel des Triggerspiegels um die z-Achse + dtrs = 10 ! Abstand der Triggerspiegelebenen + ltrs = 80 ! Laenge des Triggerspiegels + + +c die Hoehe des Triggerdetektors: + + dz_half = 30 + +c 'Deckel' und 'Boden': + + CALL ISLWSC(4.) ! LINIENDICKE: moderat +c CALL ISLWSC(2.) ! LINIENDICKE: duenn + CALL ISLN(1) ! LINIENTYP: durchgezogen + +c - von 'Folie': + x(1) = 0. + x(2) = 0. + y(1) = YTRF + y(2) = -YTRF +c - bis 'Ground': + x(3) = XTRG3 + x(4) = XTRG3 + y(3) = YTRG3 + y(4) = -YTRG3 + CALL KOORD_TRANSFORMATION(4) + + xx(1) = x(1) + xx(2) = x(3) + z(1) = dz_half + z(2) = z(1) + CALL IPL(2,XX,Z) + z(1) = -z(1) + z(2) = -z(2) + CALL IPL(2,XX,Z) + + xx(1) = x(2) + xx(2) = x(4) + z(1) = dz_half + z(2) = z(1) + CALL IPL(2,XX,Z) + z(1) = -z(1) + z(2) = -z(2) + CALL IPL(2,XX,Z) + + +c Folie: + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + z(1) = -SQRT(radiusQuad_Folie) + z(2) = +SQRT(radiusQuad_Folie) + x(1) = 0. + x(2) = 0. + y(1) = YTRF + y(2) = -YTRF + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + CALL ISLWSC(2.) ! LINIENDICKE: duenn + CALL ISLN(1) ! LINIENTYP: durchgezogen + z(1) = +SQRT(radiusQuad_Folie) + z(2) = +dz_half + x(1) = 0. + x(2) = 0. + y(1) = YTRF + y(2) = -YTRF + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + z(1) = -dz_half + z(2) = -SQRT(radiusQuad_Folie) + x(1) = 0. + x(2) = 0. + y(1) = YTRF + y(2) = -YTRF + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + +c Gitterebenen: + + z(1) = -dz_half + z(2) = +dz_half + + CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn + CALL ISLN(3) ! LINIENTYP: eng gepunktet + + +c - Massegitter vor Folie: + + if (gridInFrontOfFoil) then +c if (dx5.NE.8) then + x(1) = - d_grid_folie + x(2) = - d_grid_folie + y(1) = YTRF + y(2) = -YTRF + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + endif + + +c - forderes Gitter von VORNE: + + x(1) = XTRG1 + x(2) = XTRG1 + y(1) = YTRG1 + y(2) = -YTRG1 + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + +c - hinteres Gitter von HINTEN: + + x(1) = XTRG2 + x(2) = XTRG2 + y(1) = YTRG2 + y(2) = -YTRG2 + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + +c - geerdetes Gitter (GROUND): + + x(1) = XTRG3 + x(2) = XTRG3 + y(1) = YTRG3 + y(2) = -YTRG3 + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + +c Spiegelgitter: + + P2X = (DTRS/2)*COS((PI/2)-(ATRS/180)*PI) + P2Y = -(DTRS/2)*SIN((PI/2)-(ATRS/180)*PI) + P1X = -P2X + P1Y = -P2Y + P3X = (LTRS/2)*cos((ATRS/180)*PI) + P3Y = (LTRS/2)*sin((ATRS/180)*PI) + P4X = -P3X + P4Y = -P3Y + + +cc Spiegelmittelebene: +c +c x(1) = p3x+xTRs +c x(2) = p4x+xTRs +c y(1) = p3y +c y(2) = p4y +c CALL KOORD_TRANSFORMATION(2) +c xx(1) = x(1) +c xx(2) = xx(1) +c CALL IPL(2,XX,Z) +c xx(1) = x(2) +c xx(2) = xx(1) +c CALL IPL(2,XX,Z) + + +c forderes Spiegelgitter: + + X(1) = P3X+P1X+XTRS + X(2) = P4X+P1X+XTRS + Y(1) = P3Y+P1Y + Y(2) = P4Y+P1Y + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + +c hinteres Spiegelgitter: + + X(1) = P3X+P2X+XTRS + X(2) = P4X+P2X+XTRS + Y(1) = P3Y+P2Y + Y(2) = P4Y+P2Y + CALL KOORD_TRANSFORMATION(2) + xx(1) = x(1) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + xx(1) = x(2) + xx(2) = xx(1) + CALL IPL(2,XX,Z) + + +cc MCP3: +c +c CALL ISLWSC(3.) ! LINIENDICKE: moderat +c CALL ISLN(1) ! LINIENTYP: durchgezogen +c +c x(1) = xM3A +c x(2) = xM3E +c x(3) = xM3E +c x(4) = xM3A +c x(5) = xM3A +c y(1) = yM3 +c y(2) = yM3 +c y(3) = yM3-dM3 +c y(4) = yM3-dM3 +c y(5) = yM3 +c CALL KOORD_TRANSFORMATION(5) +c +c z(1) = ... +c z(2) = ... +c z(3) = ... +c z(4) = ... +c z(5) = ... +c CALL IPL(5,X,Z) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE KOORD_TRANSFORMATION(n) +C ================================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + real x(5),y(5),z(5) + COMMON /trans_koord/ x,y,z + + integer n ! Anzahl an zu transformierenden Koordinaten + integer i + logical help + + do i = 1, n + if (alfaTD.NE.0) then + help = x(i)-d_Folie_Achse + x(i) = help*Cos_alfaTD - y(i)*Sin_alfaTD + xTD + y(i) = help*Sin_alfaTD + y(i)*Cos_alfaTD + else + x(i) = x(i) - d_Folie_Achse + xTD + endif + enddo + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE TEXT_PLOT +C ==================== + + IMPLICIT NONE + + logical BATCH_MODE + COMMON /BATCH_MODE/ BATCH_MODE + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + common /pawc/ memory + + integer GraphTextZeilen, i + CHARACTER GraphText(15)*40 + COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText + +c integer font +c real height + +c font = -8 +c height = 2. +c write(*,'($,A)') 'TEXTFONT ?' +c read(*,*) font +c write(*,'($,A)') 'TEXT height ?' +c read(*,*) height + + CALL IZPICT('TEXT','C') ! make 'TEXT' the currrent picture + +c CALL ISELNT(3) ! Masstab '3' aktivieren +c CALL ISTXFP(font,1) ! 0: Display on screen like hardware characters + ! 1: Display on screen like IGTEXT characters +c CALL ISCHH (height) ! select charcter height +c CALL ISTXAL(0,0) ! select allignment (links unten) + + + do i = 1, GraphTextZeilen + ! Bei ITX sind X und Y in Worldcoord. anzugeben! +c CALL ITX(0.0,100.*(1-real(i)/real(GraphTextZeilen)),GRAPHTEXT(i)) + ! Auch bei IGTEXT sind X und Y in Worldcoord. anzugeben! -> ? + CALL IGTEXT(0.0,1.-real(i)/real(GraphTextZeilen), + + GRAPHTEXT(i), 0.04,0.0,'L') + enddo + + +c Text auf Bildschirm geben: + + if (.NOT.batch_mode) then + CALL IACWK(5) ! aktiviere WS 5 + CALL IZPICT('TEXT','D') ! display 'TEXT' + CALL IGTERM ! update open WS and return to + ! alfanumeric mode + CALL IDAWK(5) ! deaktiviere WS 5 + endif + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PLOT_HORIZONTAL +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 + + LOGICAL LOG_MARKER + COMMON /marker/ LOG_MARKER + + integer COLOR + real SCHNITT_X + logical VERTICAL + COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL + + logical BATCH_MODE + COMMON /BATCH_MODE/ BATCH_MODE + + integer HB_memsize + parameter (HB_memsize=1000000) + real memory(HB_memsize) + COMMON /pawc/ memory + + REAL X(2),Y(2),MITTE + INTEGER S,INDEX + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + CALL IZPICT('CHAM_1','C') ! make 'CHAM_1' the currrent picture +c CALL ISELNT(5) ! Masstab '1' aktivieren + CALL ISELNT(2) ! Masstab '2' aktivieren + + IF (COLOR .EQ. 1) THEN ! Farbkodierung fuer z-Koordinate + DO S=2,TRAJ_N + MITTE = (TRAJ_Z(S)+TRAJ_Z(S-1))/2 + IF (MITTE.LT.-18) THEN + INDEX=1 + ELSEIF (MITTE.LT.-12) THEN + INDEX=7 + ELSEIF (MITTE.LT.-6) THEN + INDEX=6 + ELSEIF (MITTE.LT.0) THEN + INDEX=5 + ELSEIF (MITTE.LT.6) THEN + INDEX=4 + ELSEIF (MITTE.LT.12) THEN + INDEX=3 + ELSEIF (MITTE.LT.18) THEN + INDEX=2 + ELSE + INDEX=1 + ENDIF + CALL ISPLCI(INDEX) + + X(1)=TRAJ_X(S-1) + X(2)=TRAJ_X(S) + Y(1)=TRAJ_Y(S-1) + Y(2)=TRAJ_Y(S) + CALL IPL(2,X,Y) + ENDDO + ELSEIF (vertical) then + CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y) + ELSE + CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Z) + ENDIF + + if (log_marker) CALL PLOT_MARKER ! Marker entsprechend Destiny + ! zeichnen + + if (.NOT.batch_mode) then + CALL IACWK(1) ! aktiviere WS 1 + CALL IZPICT('CHAM_1','D') ! display 'CHAM_1' + CALL IGTERM ! update open WS and return to + ! alfanumeric mode + CALL IDAWK(1) ! deaktiviere WS 1 + endif + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PLOT_VERTIKAL +C ======================== + + IMPLICIT NONE + +cMBc REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000),TRAJ_T(1000) + REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000) + INTEGER TRAJ_N +cMBc COMMON /GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N,TRAJ_T + COMMON /GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N + + LOGICAL LOG_MARKER + COMMON /marker/ LOG_MARKER + + integer COLOR + real SCHNITT_X + logical VERTICAL + COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL + + logical BATCH_MODE + COMMON /BATCH_MODE/ BATCH_MODE + + integer HB_memsize + parameter (HB_memsize=1000000) + real memory(HB_memsize) + COMMON /pawc/ memory + + REAL X(2),Y(2),MITTE + INTEGER i,INDEX + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +cMBc logical writeTraj2File +cMBc common /writeTraj2File/ writeTraj2File +cMBc INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' +cMBc real x_intersectTD +cMBc common /x_intersectTD/ x_intersectTD ! nur voruebergehend! +cMBc real help +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + CALL IZPICT('CHAM_2','C') ! make 'CHAM_2' the currrent picture + CALL ISELNT(2) ! Masstab '2' aktivieren + + IF (COLOR .EQ. 1) THEN ! Farbkodierung fuer z-Koordinate + DO i=2,TRAJ_N + MITTE = (TRAJ_Z(i)+TRAJ_Z(i-1))/2 + IF (MITTE.LT.-18) THEN + INDEX=1 + ELSEIF (MITTE.LT.-12) THEN + INDEX=7 + ELSEIF (MITTE.LT.-6) THEN + INDEX=6 + ELSEIF (MITTE.LT.0) THEN + INDEX=5 + ELSEIF (MITTE.LT.6) THEN + INDEX=4 + ELSEIF (MITTE.LT.12) THEN + INDEX=3 + ELSEIF (MITTE.LT.18) THEN + INDEX=2 + ELSE + INDEX=1 + ENDIF + CALL ISPLCI(INDEX) + + X(1)=TRAJ_X(i-1) + X(2)=TRAJ_X(i) + Y(1)=TRAJ_Y(i-1) + Y(2)=TRAJ_Y(i) + CALL IPL(2,X,Y) + ENDDO + ELSEIF (vertical) then + CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y) + ELSE + CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Z) + ENDIF + + if (log_marker) CALL PLOT_MARKER ! Marker entsprechend Destiny + ! zeichnen + + if (.NOT.batch_mode) then + CALL IACWK(3) ! aktiviere WS 3 + CALL IZPICT('CHAM_2','D') ! display 'CHAM_2' + CALL IGTERM ! update open WS and return to + ! alfanumeric mode + CALL IDAWK(3) ! deaktiviere WS 3 + endif + +cMBc if (writeTraj2File) then +cMBc OPEN (UNIT=90,FILE='OUT.TRAJ',DEFAULTFILE=OUTDIR,STATUS='NEW') +cMBc do i = 1, traj_n +cMBc if (TRAJ_X(i).GE.x_intersectTD) then +cMBc if (TRAJ_X(i).EQ.x_intersectTD) help=TRAJ_T(i) +cMBc write(90,*) TRAJ_T(i)-help,TRAJ_X(i)-x_intersectTD +cMBc endif +cMBc enddo +cMBc CLOSE (90) +cMBc endif + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PLOT_MARKER +C ====================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + COMMON /pawc/ memory + + REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000) + INTEGER TRAJ_N + COMMON /GRAPHIX/ TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N + + integer markerTyp(smallest_code_nr:highest_code_Nr) + real markerScale(smallest_code_nr:highest_code_Nr) + + DATA markerTyp(code_durchSpiegel ) / 20 / ! solid ball + DATA markerTyp(code_lostInTD ) / 31 / ! star x + DATA markerTyp(code_hitMCP2inactive) / 20 / ! solid ball + DATA markerTyp(code_ok ) / 27 / ! Raute + DATA markerTyp(code_decay ) / 28 / ! hollow cross + DATA markerTyp(code_vorbei ) / 24 / ! circle + DATA markerTyp(code_reflektiert ) / 26 / ! hollow triangle + DATA markerTyp(code_wand ) / 20 / ! solid ball + DATA markerTyp(code_lost ) / 29 / ! solid star * + DATA markerTyp(code_dtsmall ) / 30 / ! hollow star * + + DATA markerScale(code_durchSpiegel ) / 1.0 / ! solid ball + DATA markerScale(code_lostInTD ) / 1.5 / ! star x + DATA markerScale(code_hitMCP2inactive) / 1.0 / ! solid ball + DATA markerScale(code_ok ) / 2. / ! point + DATA markerScale(code_decay ) / 1.5 / ! hollow cross + DATA markerScale(code_vorbei ) / 1.5 / ! circle + DATA markerScale(code_reflektiert ) / 1.5 / ! hollow triangle + DATA markerScale(code_wand ) / 1.0 / ! solid ball + DATA markerScale(code_lost ) / 2.0 / ! solid star * + DATA markerScale(code_dtsmall ) / 2.0 / ! hollow star * + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + integer MT + real MS + + MT = markerTyp(destiny) + MS = markerScale(destiny) + + CALL ISMKSC(MS) ! Markergroesse setzen + CALL ISMK(MT) ! Markertyp waehlen + CALL IPM(1,TRAJ_X(TRAJ_N),TRAJ_Y(TRAJ_N)) ! Marker plotten + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SCHNITT +C ================== + + IMPLICIT NONE + + REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000),Y,Z,FACTOR + INTEGER TRAJ_N,S + COMMON /GRAPHIX/ TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N + + integer COLOR + real SCHNITT_X + logical VERTICAL + COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + COMMON /pawc/ memory + + DO S= 2, TRAJ_N + IF (TRAJ_X(S) .GE. SCHNITT_X) THEN + FACTOR = (SCHNITT_X-TRAJ_X(S-1))/(TRAJ_X(S)-TRAJ_X(S-1)) + Y=TRAJ_Y(S-1) + (TRAJ_Y(S)-TRAJ_Y(S-1))*FACTOR + Y = -Y ! DAMIT MAN ANSICHT IN STRAHLRICHTUNG BEKOMMT + Z=TRAJ_Z(S-1) + (TRAJ_Z(S)-TRAJ_Z(S-1))*FACTOR + if (abs(y).LE.30 .AND. abs(z).LE.30) then + CALL HFILL (50,Y,Z,1.) + endif + RETURN + ENDIF + ENDDO + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SCHNITT_PLOT +C ======================= + + IMPLICIT NONE + + logical BATCH_MODE + COMMON /BATCH_MODE/ BATCH_MODE + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory + + CALL IZPICT('HISTO','C') ! make 'HISTO' the currrent picture + CALL HPLOT(50,'BOX',' ',1) ! plotte Histogramm 50 (Boxes) +c CALL HPLOT(50,'SCAT',' ',1) ! plotte Histogramm 50 (Scatterplot) + + if (.NOT.batch_mode) then + CALL IACWK(4) ! aktiviere WS 4 + CALL IZPICT('HISTO','D') ! display 'HISTO' + CALL IGTERM ! update open WS and return to + ! alfanumeric mode + CALL IDAWK(4) ! deaktiviere WS 4 + endif + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE MAKE_PS(FILENAME) +C ============================ + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + + real XSIZE /12./, YSIZE /6./ + CHARACTER*100 PSZEILE + CHARACTER*(*) FILENAME + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory + + +c OPEN (30,FILE=FILENAME//'.PS',CARRIAGECONTROL='LIST',DEFAULTFILE=OUTDIR, +c + STATUS='UNKNOWN') + + OPEN (30,FILE='MUPIC.TMP',FORM='FORMATTED',DEFAULTFILE=OUTDIR, + + STATUS='UNKNOWN') + + +c ZUSAMMENFUEGEN VON 'CHAM_1', 'HISTO' UND 'TEXT': + + CALL IZPICT('CHAM_1','C') ! make 'CHAM_1' the currrent picture + CALL IZMERG('HISTO',0.6,0.0,0.4,' ') ! verbinde 'HISTO' mit 'CHAM_1' + CALL IZPICT('CHAM_1','C') ! vielleicht gar nicht noetig! + CALL IZMERG('TEXT',0.6,0.5,0.4,' ') ! verbinde 'TEXT' mit 'CHAM_1' + + CALL IGMETA(-30,-4121) ! graphic output to metafile on lun 30 only, + ! devide into two by one pictures + CALL IGRNG(XSIZE,YSIZE) ! open PS and define size + CALL IZPICT('CHAM_1','D') ! display 'CHAM_1' + CALL ICLRWK(2,0) ! clear WS 2 + CALL IZPICT('CHAM_2','D') ! display 'CHAM_2' + CALL IGMETA(0,0) ! deactivate metafile + CALL ICLWK(2) ! close WS 2 + + +c ANFUEGEN EINES ' ' AN DEN ANFANG JEDER PS-FILE-ZEILE: + + 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) + +c CLOSE (30,STATUS='KEEP') + + END + + +c=============================================================================== diff --git a/mutrack/src/SUB_TRIGGER.FOR b/mutrack/src/SUB_TRIGGER.FOR new file mode 100644 index 0000000..eee5f7e --- /dev/null +++ b/mutrack/src/SUB_TRIGGER.FOR @@ -0,0 +1,928 @@ +c****************************************************************************** +c* ... SUB_TRIGGER.FOR * +c* * +c* Die Routinen dieser Datei dienen der Berechnung und der Ausgabe * +c* von Flugbahnen geladener Teilchen innerhalb des NEMU - Triggerdetektors. * +c* * +c* Die Daten fuer die DetektorGEOmetrie (dx1 bis dx11, bzw. dy1 bis dy15) * +c* werden beim Compilieren aus 'GEO_TRIGGER.INC' eingelesen. * +c* * +c* F -> FOLIE * +c* V -> Gitter VORNE * +c* H -> Gitter HINTEN * +c* G -> Gitter GROUND (geerdetes Gitter nach HINTEN) * +c* 3 -> MCP3 (front) * +c* * +c****************************************************************************** + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE READ_TRIGGER_GEO +c =========================== + + implicit none + + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC' + + integer iostat + +c namelist: + + namelist /trigger_grids/ + + dist_Wires_V1,dist_Wires_V2,dist_Wires_V3, + + dist_Wires_H1,dist_Wires_H2,dist_Wires_G, + + dWires_V1,dWires_V2,dWires_V3,dWires_H1,dWires_H2,dWires_G + + + read(lunREAD,nml=trigger_grids,iostat=iostat) ! wurde in SUB_INPUT geoeffnet + ! iostat notwendig, da bei aelteren Files keine namelist 'trigger_grids' + ! vorhanden ist. Dort: Defaultwerte. + + WireRadiusQuad_V1 = dwires_V1*dWires_V1/4. + WireRadiusQuad_V2 = dwires_V2*dWires_V2/4. + WireRadiusQuad_V3 = dwires_V3*dWires_V3/4. + WireRadiusQuad_H1 = dwires_H1*dWires_H1/4. + WireRadiusQuad_H2 = dwires_H2*dWires_H2/4. + WireRadiusQuad_G = dwires_G *dWires_G /4. + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE TRIGGER(m_,q_,t_,x_,v_,DEBUG_,GRAPHICS_,n_return_) +c ============================================================= + + +c Deklarationen: + + implicit none + + real m_,q_,t_,x_(3),v_(3) ! die Aufruf-Parameter + real E, vSquare ! EnergieFkt und Geschw.Quadrat + real dt,delta_x,delta_y,delta_xs,delta_xp,v_s,v_p,a + real sqrt_2,c + + real barriere_FV,barriere_VH,barriere_HG,barriere_V3 + + integer n_return_ + + integer vorne_hinten ! + integer vorne_hinten_refl ! die Label + integer vorne_mcp3 ! fuer GOTO-Anweisungen + integer vorne_mcp3_refl ! + + logical log_p4 ! notiert, ob Pfosten P4 getroffen wird. + logical DEBUG_,GRAPHICS_ + + +c Die Trigger-Geometrie + + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + + +c Variablen fuer Test ob Draht getroffen wurde: + + integer DrahtNr + real help,DistToWire(2) + logical WireHit + + logical TestOnWireHit + COMMON /TestOnWireHit/ TestOnWireHit + + integer seed + COMMON /seed/ seed + + +c Konstanten-Definitionen: + + parameter (sqrt_2=1.414213562, c=299.7925) ! c in [mm/ns] + + +c Common-Bloecke: + + INCLUDE 'mutrack$sourcedirectory:COM_TD_INT.INC' + INCLUDE 'mutrack$sourcedirectory:COM_TD_EXT.INC' + + +c Funktionen-Deklarationen: + + E(vSquare) = m/2.*vSquare/c**2. ! E in [keV]; vSquare==v**2. + + +c hier werden die Labels getauft: + + assign 100 to vorne_hinten + assign 200 to vorne_hinten_refl + assign 300 to vorne_mcp3 + assign 400 to vorne_mcp3_refl + + +c Uebertragen der Aufruf-Parameter auf die lokalen Variablen: + + m = m_ + q = q_ + + t = t_ + + x = 0. + y = x_(2) + z = x_(3) + + v_x = v_(1) + v_y = v_(2) + v_z = v_(3) + + DEBUG = DEBUG_ + GRAPHICS = GRAPHICS_ + n_return = 0 ! n_return > 100 <-> Fehlermeldungen + + +c sonstige Start-Werte: + + E0 = E(v_x**2+v_y**2.+v_z**2.) + + barriere_FV = q * (U_V - U_F) + barriere_VH = q * (U_H - U_V) + barriere_HG = q * (0. - U_H) + barriere_V3 = q * (U_MCP3 - U_V) + + log_refl_VH = .false. ! das Teilchen ist noch + log_refl_V3 = .false. ! nirgends reflektiert worden + log_p4 = .false. ! und hat Pfosten 4 nicht beruehrt + + +c............................................................................... +c hier startet das Teilchen: +c -------------------------- + + dt = 0 + call TestAndOut('F ',*800) + if (v_x.LT.0.) then ! Start in neg. x-Richtung + n_return = 103 + if (DEBUG) call outText(n_return) + GOTO 800 + endif + + +C zwischen 'FOLIE' und 'VORNE': ----------------------------- + + if (E(v_x**2.).LT.barriere_FV) then ! Potentialbarriere F-V zu gross + n_return = 104 + if (DEBUG) call outText(n_return) + GOTO 800 + endif + + if (barriere_FV.EQ.0.) then ! keine Spannung zwischen F und V + if (v_x.EQ.0.) then ! U=0 und v_x=0 => + n_return = 105 ! Teilchen bleibt stehen + if (DEBUG) call outText(n_return) + GOTO 800 + endif + dt = dx1/v_x ! v_x > 0 + else + a = -barriere_FV/(m*dx1) * c**2. ! <- a = F/m = q/m*(U_F-U_V)/dx1 + ! = -barriere_FV/(m*dx1) + dt = (sqrt(v_x**2.+2.*a*dx1)-v_x)/a ! <- ergibt sich aus x=v*t+1/2*a*t**2 + ! mit richtiger V.Z.-Wahl ('+') + v_x = v_x + a*dt + endif + + x = dx1 + y = y + v_y*dt + z = z + v_z*dt + t = t + dt + +c haben wir vielleicht einen Pfosten getroffen? Wenn nein, gib die Trajektorien-Daten aus + + if (y.GT.dy3) then ! (Bahn FV1) + call pfosten(1,*800) + elseif (y.GT.dy5) then ! (Bahn FV2) + call pfosten(3,*800) + elseif (y.LT.-dy4) then ! (Bahn FV5) + call pfosten(2,*800) + elseif (y.LT.-dy6) then ! (Bahn FV4) + call pfosten(4,*800) + else ! (Bahn FV3) + call TestAndOut('V1 ',*800) + ! Treffen wir einen Gitterstab von V1? + if (testOnWireHit) then + DrahtNr = nInt(y/dist_Wires_V1) + distToWire(1) = 0. + distToWire(2) = y - DrahtNr*dist_Wires_V1 + call Test_WireHit(distToWire,WireRadiusQuad_V1,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + endif + + +c innerhalb von 'VORNE': +c ---------------------- + + if (y+dy6.LT.-dx7*v_y/v_x) log_p4=.true.! Teilchen trifft auf Pfosten 4 + + if (v_y.LE.-v_x) goto 20 ! Flugbahn ist parallel zu Ebene V2 + ! bzw. Schnitt bei dt < 0 + + +c Schnittpunkt der Bahn (y'=y+delta_x*v_y/v_x) mit Ebene V2 (y'=dx2-delta_x): + + if (v_x.EQ.0.) then + if (v_y.LT.0.) then + dt = (-dy4-y)/v_y + x = dx1 + y = -dy4 + z = z + v_z*dt + t = t + dt + call pfosten(2,*800) + endif + delta_x = 0 + else + delta_x = (dx2-y)/(1+v_y/v_x) + endif + + if (delta_x.GT.dx2+dy8) goto 20 ! Bahn schneidet erst Ebene V3 + + if (v_x.NE.0.) then + dt = delta_x/v_x + else + dt = (dx2-delta_x-y)/v_y + endif + x = x + delta_x + y = dx2 - delta_x + z = z + v_z*dt + t = t + dt + + if (log_p4) call pfosten(4,*800) ! (Bahn VV8) + + if (y.GT.dy5) then ! (Bahn VV1) + call pfosten(3,*800) + elseif (y.GE.-dy11) then ! (Bahn VV2) + call TestAndOut('V2 ',*800) + ! Treffen wir einen Gitterstab von V2? + if (testOnWireHit) then + DrahtNr = nInt(y/(.5*sqrt_2*dist_Wires_V2)) + distToWire(2) = y - DrahtNr*.5*sqrt_2*dist_Wires_V2 + distToWire(1) = -distToWire(2) + call Test_WireHit(distToWire,WireRadiusQuad_V2,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + goto vorne_hinten + else + call pfosten(5,*800) ! (Bahn VV3) + endif + + +c Schnittpunkt der Bahn (y'=y+delta_x*v_y/v_x) mit Ebene V3 (y'=-dy8): + +20 delta_y = -dy8-y + dt = delta_y/v_y + x = x + v_x*dt + y = -dy8 + z = z + v_z*dt + t = t + dt + + if (log_p4) call pfosten(4,*800) ! (Bahn VV8) + + if (x.GT.dx1+dx2+dy11) then ! (Bahn VV3) + call pfosten(5,*800) + elseif (x.GT.dx1+dx2+dy8-dx10) then ! (Bahn VV4) + call pfosten(13,*800) + elseif (x.GE.dx1+dx8) then ! (Bahn VV5) + call TestAndOut('V3 ',*800) + ! Treffen wir einen Gitterstab von V3? + if (testOnWireHit) then + help = x-dx1-dx8 + DrahtNr = nInt(help/dist_Wires_V3) + distToWire(1) = help - DrahtNr*dist_Wires_V3 + distToWire(2) = 0. + call Test_WireHit(distToWire,WireRadiusQuad_V3,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + goto vorne_mcp3 + else ! (Bahn VV6) + call pfosten(12,*800) + endif + + +c zwischen 'VORNE' und 'HINTEN': vorne_hinten +c ------------------------------------------- + +100 v_s = (v_x + v_y)/sqrt_2 ! v_s: v senkrecht zur Spiegelebene + v_p = (v_x - v_y)/sqrt_2 ! v_p: v parallel zur Spiegelebene + + if (barriere_VH.EQ.0.) then ! keine Spannung zwischen V und H + dt = dx3/sqrt_2 / v_s ! v_s > 0, sonst waere V3 gar nicht + x = x + v_x*dt ! erreicht worden + y = y + v_y*dt + else + a = -barriere_VH * sqrt_2/(m*dx3) * c**2. + + if (E(v_s**2.).LT.barriere_VH) goto vorne_hinten_refl + + dt = (sqrt(v_s**2.+sqrt_2*a*dx3)-v_s)/a ! aus x=v*t+a/2*t**2 + delta_xs = dx3/sqrt_2 ! = Versetzung senkrecht zur Spiegelebene + delta_xp = v_p*dt ! = Versetzung parallel zur Spiegelebene + v_s = v_s + a*dt + + x = x + (delta_xs + delta_xp)/sqrt_2 + y = y + (delta_xs - delta_xp)/sqrt_2 + v_x = (v_s + v_p)/sqrt_2 + v_y = (v_s - v_p)/sqrt_2 + endif + + z = z + v_z*dt + t = t + dt + if (y.GT.dy7) then ! (Bahn VH1) + call pfosten(6,*800) + elseif (y.GE.-dy13) then ! (Bahn VH2) + call TestAndOut('H1 ',*800) + ! Treffen wir einen Gitterstab von H1? + if (testOnWireHit) then + DrahtNr = nInt(y/(.5*sqrt_2*dist_Wires_H1)) + distToWire(2) = y - DrahtNr*.5*sqrt_2*dist_Wires_H1 + distToWire(1) = -distToWire(2) + call Test_WireHit(distToWire,WireRadiusQuad_H1,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + else ! (Bahn VH3) + call pfosten(9,*800) + endif + + +c innerhalb von 'HINTEN': +c ----------------------- + + if (v_y.LE.0.) goto 30 ! Flugbahn parallel zu (y'=dy9) + ! bzw. Schnitt bei dt < 0 + + +c Schnittpunkt mit (y'=dy9): + + delta_x = (dy9-y)*v_x/v_y ! v_y <> 0. + if (x+delta_x.GT.d_Folie_Hinten2) goto 30 + + dt = (dy9-y)/v_y + x = x + delta_x + y = dy9 + z = z + v_z*dt + t = t + dt + + if (x.LT.d_Folie_Hinten2-dx4-dy7) then ! (Bahn HH1) + call pfosten(6,*800) + elseif (x.LT.d_Folie_Hinten2 -dx6) then ! (Bahn HH2) + call pfosten(7,*800) + else ! (Bahn HH3) + call pfosten(8,*800) + endif + + +c Schnittpunkt mit Ebene H2 (x'=d_Folie_Hinten2): + +30 delta_x = d_Folie_Hinten2 - x + dt = delta_x/v_x ! v_x > 0. + x = d_Folie_Hinten2 + y = y + v_y*dt + z = z + v_z*dt + t = t + dt + + if (y.GT.dy12) then ! (Bahn HH3) + call pfosten(8,*800) + elseif (y.GT.dy14) then ! (Bahn HH4) + call pfosten(10,*800) + elseif (y.LT.-dy13) then ! (Bahn HH7) + call pfosten(9,*800) + elseif (y.LT.-dy15) then ! (Bahn HH6) + call pfosten(11,*800) + else ! (Bahn HH5) + call TestAndOut('H2 ',*800) + ! Treffen wir einen Gitterstab von H2? + if (testOnWireHit) then + DrahtNr = nInt(y/dist_Wires_H2) + distToWire(1) = 0. + distToWire(2) = y - DrahtNr*dist_Wires_H2 + call Test_WireHit(distToWire,WireRadiusQuad_H2,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + endif + + +c zwischen 'HINTEN' und 'GROUND': +c ------------------------------- + + if (E(v_x**2.).LT.barriere_HG) then ! Potentialbarriere H-G zu gross + n_return = 106 + if (DEBUG) call outText(n_return) + GOTO 800 + endif + + if (barriere_HG.EQ.0.) then ! keine Spannung zwischen H und G + dt = dx5/v_x ! v_x > 0. + else + a = -barriere_HG/(m*dx5) * c**2. + dt = (sqrt(v_x**2.+2.*a*dx5)-v_x)/a + v_x = v_x + a*dt + endif + + x = d_Folie_Hinten2 + dx5 + y = y + v_y*dt + z = z + v_z*dt + t = t + dt + if (y.GT.dy14) then ! (Bahn HG1) + call pfosten(10,*800) + elseif (y.GE.-dy15) then ! (Bahn HG2) + if (z.GT.dz1) then + call pfosten(12,*800) + elseif (z.LT.-dz2) then + call pfosten(13,*800) + else + call TestAndOut('G ',*800) + ! Treffen wir einen Gitterstab von G? + if (testOnWireHit) then + DrahtNr = nInt(y/dist_Wires_G) + distToWire(1) = 0. + distToWire(2) = y - DrahtNr*dist_Wires_G + call Test_WireHit(distToWire,WireRadiusQuad_G,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + n_return = 0 ! Teilchen verlaesst TD durch G + endif + GOTO 800 + else ! (Bahn HG3) + call pfosten(11,*800) + endif + + +c REFLEKTION zwischen 'VORNE' und 'HINTEN': vorne_hinten_refl +c ----------------------------------------------------------- + +200 if (log_refl_V3) then ! schon an MCP3, jetzt an + n_return = 107 ! HINTEN reflektiert + if (DEBUG) call outText(n_return) + GOTO 800 + endif + + log_refl_VH = .true. ! die Reflektion notieren + + dt = -2.*v_s/a ! folgt aus v'=-v und v'=v+a*t + x = x + v_p * dt / sqrt_2 ! senkrecht zur Spiegelflaeche + y = y - v_p * dt / sqrt_2 ! findet keine Versetzung statt + z = z + v_z*dt + t = t + dt + v_x = (-v_s + v_p)/sqrt_2 ! v_s geht bei der Spiegelung + v_y = (-v_s - v_p)/sqrt_2 ! in -(v_s) ueber + + if (y.GT.dy5) then ! (Bahn VHr1) + call pfosten(3,*800) + elseif (y.GE.-dy11) then ! (Bahn VHr2) + call TestAndOut('V2 ',*800) + ! Treffen wir einen Gitterstab von V2? + if (testOnWireHit) then + DrahtNr = nInt(y/(.5*sqrt_2*dist_Wires_V2)) + distToWire(2) = y - DrahtNr*.5*sqrt_2*dist_Wires_V2 + distToWire(1) = -distToWire(2) + call Test_WireHit(distToWire,WireRadiusQuad_V2,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + else ! (Bahn VHr3) + call pfosten(5,*800) + endif + + +c innerhalb von 'VORNE' (nach Reflektion an 'HINTEN'): +c ---------------------------------------------------- + + if (v_x.GE.0.) goto 40 ! Flugbahn parallel zu V1 + ! bzw. Schnitt bei dt < 0 + + +c Schnittpunkt mit V1-Ebene (x'=dx1): + + delta_y = (dx1-x)*v_y/v_x + if (y+delta_y.LT.-dy8) goto 40 + + dt = (dx1-x)/v_x + x = dx1 + y = y + delta_y + z = z + v_z*dt + t = t + dt + + if (y.GT.dy5) then ! (Bahn VVr1) + call pfosten(3,*800) + elseif (y.GT.dy3) then ! (Bahn VVr2) + call pfosten(1,*800) + elseif (y.LT.-dy6) then ! (Bahn VVr5) + call pfosten(4,*800) + elseif (y.LT.-dy4) then ! (Bahn VVr4) + call pfosten(2,*800) + else ! (Bahn VVr3) + n_return = 108 ! Teilchen zurueck auf V1 + if (DEBUG) call outText(n_return) + RETURN + endif + + +c Schnittpunkt mit V3-Ebene (y'=-dy8): + +40 delta_y = -dy8-y + dt = delta_y/v_y ! v_y < 0. + x = x + v_x*dt + y = -dy8 + z = z + v_z*dt + t = t + dt + + if (x.LT.dx1+dx7) then ! (Bahn VVr5) + call pfosten(4,*800) + elseif (x.LT.dx1+dx8) then ! (Bahn VVr4) + call pfosten(14,*800) + elseif (x.GT.dx1+dx2+dy11) then ! (Bahn VVr9) + call pfosten(5,*800) + elseif (x.GT.dx1+dx2+dy8-dx10) then ! (Bahn VVr8) + call pfosten(15,*800) + else ! (Bahn VVr7) + call TestAndOut('V3 ',*800) + ! Treffen wir einen Gitterstab von V3? + if (testOnWireHit) then + help = x-dx1-dx8 + DrahtNr = nInt(help/dist_Wires_V3) + distToWire(1) = help - DrahtNr*dist_Wires_V3 + distToWire(2) = 0. + call Test_WireHit(distToWire,WireRadiusQuad_V3,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + endif + + +c zwischen 'VORNE' und 'MCP3': vorne_mcp3 +c ---------------------------------------- + +300 a = +barriere_V3/(m*dy10) * c**2. + + if (E(v_y**2.).LT.barriere_V3) goto vorne_mcp3_refl + + if (a.EQ.0.) then + dt = -dy10/v_y ! v_y < 0. + else + dt = (-sqrt(v_y**2.-2.*a*dy10)-v_y)/a ! aus dy=v*dt+a/2*dt**2 mit + v_y = v_y + a * dt ! richtiger V.Z.-Wahl ('-') + endif + + x = x + v_x*dt + y = -dy8-dy10 + z = z + v_z*dt + t = t + dt + + if (x.LT.dx1+dx8) then ! (Bahn V31) + call pfosten(14,*800) + elseif (x.LT.dx1+dx9) then ! (Bahn V32) + call pfosten(16,*800) + elseif (x.GT.dx1+dx2+dy8-dx10) then ! (Bahn V35) + call pfosten(15,*800) + elseif (x.GT.dx1+dx2+dy8-dx11) then ! (Bahn V34) + call pfosten(17,*800) + else ! (Bahn V33) + if (((x - xCenter_MCP3)**2.+z**2).GT.radiusQuad_MCP3) then + if (z.GE.0 .AND. x.GE. xCenter_MCP3) then + call pfosten(19,*800) + elseif (z.GE.0 .AND. x.LT. xCenter_MCP3) then + call pfosten(18,*800) + elseif (z.LT.0 .AND. x.LT. xCenter_MCP3) then + call pfosten(20,*800) + else + call pfosten(21,*800) + endif + else + call TestAndOut('M3 ',*800) + if (testOnWireHit .AND. ran(seed).GT.efficiencyM3) then + n_return = -9 ! Teilchen NICHT in MCP3 + else ! nachgewiesen + n_return = -10 ! Teilchen in MCP3 + endif ! nachgewiesen + endif + GOTO 800 + endif + + +c REFLEKTION zwischen 'VORNE' und 'MCP3': vorne_mcp3_refl +c -------------------------------------------------------- + +400 if (log_refl_VH) then ! schon an HINTEN, jetzt an + n_return = 109 ! MCP3 reflektiert + if (DEBUG) call outText(n_return) + GOTO 800 + endif + + log_refl_V3 = .true. ! die Reflektion notieren + + if (v_x.LE.0.) then ! Reflektion an MCP3 mit + n_return = 110 ! negativem v_x + if (DEBUG) call outText(n_return) + GOTO 800 + endif + + dt = -2.*v_y/a + x = x + v_x*dt ! y'=y + z = z + v_z*dt + t = t + dt + + if (x.GT.dx1+dx2+dy8-dx10) then ! (Bahn V3r1) + call pfosten(15,*800) + elseif (x.GT.dx1+dx2+dy11) then ! (Bahn V3r2) + call pfosten(5,*800) + else ! (Bahn V3r3) + v_y = -v_y ! v_x'=v_x + call TestAndOut('V3 ',*800) + ! Treffen wir einen Gitterstab von V3? + if (testOnWireHit) then + help = x-dx1-dx8 + DrahtNr = nInt(help/dist_Wires_V3) + distToWire(1) = help - DrahtNr*dist_Wires_V3 + distToWire(2) = 0. + call Test_WireHit(distToWire,WireRadiusQuad_V3,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + endif + + +c innerhalb von 'VORNE' (nach Reflektion an 'MCP3'): +c --------------------------------------------------- + + +c Schnittpunkt mit Ebene V2 (y'=dx2-(x'-dx1)): + + delta_x = (dx1+dx2-y+x*v_y/v_x)/(1+v_y/v_x)-x ! v_x,v_y > 0. + dt = delta_x/v_x + x = x + delta_x + y = y + v_y*dt + z = z + v_z*dt + t = t + dt + + if (y.GT.dy5) then ! (Bahn VVrr1) + call pfosten(3,*800) + elseif (y.GE.-dy11) then ! (Bahn VVrr2) + call TestAndOut('V2 ',*800) + ! Treffen wir einen Gitterstab von V2? + if (testOnWireHit) then + DrahtNr = nInt(y/(.5*sqrt_2*dist_Wires_V2)) + distToWire(2) = y - DrahtNr*.5*sqrt_2*dist_Wires_V2 + distToWire(1) = -distToWire(2) + call Test_WireHit(distToWire,WireRadiusQuad_V2,v_x,v_y,WireHit) + if (WireHit) then + n_return = -5 + goto 800 + endif + endif + goto vorne_hinten + else ! (Bahn VVrr3) + call pfosten(5,*800) + endif + + + +c............................................................................... +800 continue + +c Die Trajektorienberechnung innerhalb des TDs ist beendeet -> bringe die +c Aufruf-Variablen auf den aktuellen Stand und gehe zurueck ins Hauptprogramm. + + t_ = t + + x_(1) = x + x_(2) = y + x_(3) = z + + v_(1) = v_x + v_(2) = v_y + + n_return_ = n_return + + RETURN + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE PFOSTEN(p,*) +c ======================= + + implicit none + integer p + character pfo*3 /'P '/ + + INCLUDE 'mutrack$sourcedirectory:COM_TD_INT.INC' + + write(pfo(2:3),'(I2)') p + call TestAndOut(pfo) + + if (log_refl_V3) then + n_return = p+50 + elseif (log_refl_VH) then + n_return = p+25 + else + n_return = p + endif + + RETURN 1 + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE TestAndOut(text,*) +c ============================= + + implicit none + + INCLUDE 'mutrack$sourcedirectory:COM_TD_INT.INC' + INCLUDE 'mutrack$sourcedirectory:COM_TD_EXT.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC' + INCLUDE 'mutrack$sourcedirectory:COM_OUTPUT.INC' + + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000) ! Koordinatenfelder fuer die + real yKoord(1000) ! Graphikausgabe + real zKoord(1000) ! +cMBc real tKoord(1000) ! + integer nKoord ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord ! fuer Graphikaufruf + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord ! fuer Graphikaufruf + + real Ekin, help1, help2, help3, help4, c + character text*3 + + parameter (c=299.7925) ! <- c in [mm/ns]! + + +c Ausgabe der DEBUG-Informationen: + + if (DEBUG) then + Ekin = m/2.*(v_x**2.+v_y**2.+v_z**2.) / c**2. + if (alfaTD.NE.0) then + help1 = (x-d_Folie_Achse)*Cos_alfaTD - y*Sin_alfaTD + xTD + help2 = (x-d_Folie_Achse)*Sin_alfaTD + y*Cos_alfaTD + help3 = v_x*Cos_alfaTD - v_y*Sin_alfaTD + xTD + help4 = v_x*Sin_alfaTD + v_y*Cos_alfaTD + + write(lun(1),1)text,help1,help2,z,help3,help4,v_z,Ekin + else + write(lun(1),1)text,t,x-d_Folie_Achse+xTD,y,z, + + v_x,v_y,v_z,Ekin + endif + endif +1 format(5X,A4,3X,F6.1,2X,F7.2,X,F6.2,X,F6.2,2X,F6.2,X, + + F6.2,X,F6.2,2X,G13.6) + + +c Speichern der Koordinaten fuer GRAPHICS: + + if (Graphics) then + nKoord = nKoord + 1 + if (alfaTD.NE.0) then + xKoord(nKoord) = (x-d_Folie_Achse)*Cos_alfaTD - + + y*Sin_alfaTD + xTD + yKoord(nKoord) = (x-d_Folie_Achse)*Sin_alfaTD + + + y*Cos_alfaTD + else + xKoord(nKoord) = x-d_Folie_Achse + xTD + yKoord(nKoord) = y + endif + zKoord(nKoord) = z +cMBc tKoord(nKoord) = t + + if (nKoord.EQ.1000) then + call plot_vertikal + xKoord(1) = xKoord( 999) ! die letzten beiden uebernehme + yKoord(1) = yKoord( 999) ! damit gegebenenfalls der Rich + zKoord(1) = zKoord( 999) ! pfeil gezeichnet werden kann. +cMBc tKoord(1) = tKoord( 999) + xKoord(2) = xKoord(1000) + yKoord(2) = yKoord(1000) + zKoord(2) = zKoord(1000) +cMBc tKoord(2) = tKoord(1000) + nKoord = 2 + endif + + + endif + + +c Testen, ob Teilchen stehen bleibt: + + if (v_x.EQ.0. .AND.v_y.EQ.0.) then + if (text(1:1).NE.'F') then + n_return = 111 + if (DEBUG) call outText(n_return) + RETURN 1 + endif + endif + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE outText(n) +c ===================== + + implicit none + integer n + character text*70 + + INCLUDE 'mutrack$sourcedirectory:COM_OUTPUT.INC' + + +c -10: Teilchen in MCP3 nachgewiesen +c - 9: Teilchen nicht in MCP3 nachgewiesen +c - 5: Teilchen traf auf Gitterstab + +c 0: TD durch G verlassen + +c 1-25: Nummer der direkt getroffenen Pfosten +c 26-50: Nummer der nach Refl. an Hinten getroffenen Pfosten + 15 +c 51-75: Nummer der nach Refl. an MCP3 getroffenen Pfosten + 30 + +c 12: oberhalb von G +c 13: unterhalb von G +c 18: rechts oben von MCP3 (in Flugrichtung) +c 19: links oben von MCP3 (in Flugrichtung) +c 20: rechts unten von MCP3 (in Flugrichtung) +c 21: links unten von MCP3 (in Flugrichtung) + + + if (n.EQ.101) then + text='Startposition auf Folientraeger' + elseif (n.EQ.103) then + text='Start in negative x-Richtung' + elseif (n.EQ.104) then + text='Teilchen zwischen FOLIE und VORNE reflektiert' + elseif (n.EQ.105) then + text='v_x=0 und U(FOLIE,VORNE)=0 -> Teilchen steht' + elseif (n.EQ.106) then + text='Teilchen zwischen HINTEN und GROUND reflektiert' + elseif (n.EQ.107) then + text='Reflektion bei MCP3 und bei HINTEN' + elseif (n.EQ.108) then + text='Teilchen zurueck auf Gitter V1' + elseif (n.EQ.109) then + text='Reflektion bei HINTEN und bei MCP3' + elseif (n.EQ.110) then + text='Teilchen zwischen VORNE und MCP3 reflektiert '// + + 'mit v_x <=0' + elseif (n.EQ.111) then + text='Teilchen bleibt stehen' + endif + + write(lun(1),*) ' >>> ',text + + END + + +c=============================================================================== + +