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