LMU/musrsim
LMU/musrsim
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
musrsim/mutrack/src/SUB_OUTPUT.FOR

2875 lines
83 KiB
Fortran
Raw Blame History

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? (<n,a,c> = 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===============================================================================
Reference in New Issue View Git Blame Copy Permalink