OPTIONS /EXTEND_SOURCE SUBROUTINE read_inputFile c ========================= IMPLICIT NONE c Diese Subroutine liest das Eingabe-file 'ACCEL.INPUT' und stellt c die Simulationsparameter fuer das Programm entsprechend ein. Die Parameter c befinden sich alle in einem COMMON-Block und stehen so im gesamten Programm c zur Verfuegung. c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c name-list: namelist /parameter_liste/ + TestRun, mappenName, dy_HeWindow,dz_HeWindow, + Startflaeche,x0_, + randomStarts, random_energy,lowerE0,upperE0,sigmaE0,adjustSigmaE0, + random_position,StartBreite,StartHoehe,StartRadius,sigmaPosition, + random_winkel,StartLambertOrd,SigmaWinkel, + Masse_,Ladung_, U_Tgt_,U_Gua_,U_G1_, B_Helm_,B_TD_, + E0_,y0_,z0_,theta0_,phi0_, E0InterFromFile, + artList, UseDecay, DEBUG, DEBUG_Anzahl, + GRAPHICS, GRAPHICS_Anzahl, n_postSkript, iMonitor, n_outWhere, + createPhysTab, NTP_start,NTP_stop,NTP_40mm, + eps_x,eps_v,log_relativ, maxStep, dtsmall, maxBelowDtSmall, log_confine, + scaleFactor c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' INCLUDE 'accel$sourcedirectory:COM_DIRS.INC' INCLUDE 'accel$sourcedirectory:COM_GEO.INC' character*40 inputName /'ACCEL.INPUT'/ COMMON /inputName/ inputName integer k ! Zaehlvariable logical flag logical flag_message /.false./ real help integer ihelp character antwort*5 real x0_ / 0. / ! StartKoordinate c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Variablen im Zusammenhang mit den Eingabefile-Listen 'LISTn.INPUT': integer lastOne /0/, fileNr, iostat, length logical testRun_ character datum*9,uhrzeit*8 c die Anzahl zufallsverteilter Starts: integer randomStarts / 50 / c die lokalen Variablen fuer das Einlesen der Schleifenparameter, die dann c in das Feld 'par' uebertragen werden: ! von ! bis ! step ! real U_Tgt_(3) / 0. , +1.e10 , -1.e10 / real U_Gua_(3) / 0. , +1.e10 , -1.e10 / real U_G1_(3) / 0. , +1.e10 , -1.e10 / real B_Helm_(3) / 0. , +1.e10 , -1.e10 / real B_TD_(3) / 0. , +1.e10 , -1.e10 / real Masse_(3) / 105659. , +1.e10 , -1.e10 / real Ladung_(3) / 1. , +1.e10 , -1.e10 / real E0_(3) / 0. , +1.e10 , -1.e10 / real y0_(3) / 0. , +1.e10 , -1.e10 / real z0_(3) / 0. , +1.e10 , -1.e10 / real theta0_(3) / 0. , +1.e10 , -1.e10 / real phi0_(3) / 0. , +1.e10 , -1.e10 / character*80 zeile c die lokalen Variablen fuer das Einlesen der logicals fuer die Ausgabe der c verschiedenen Statistiken im Log-file, die dann in das Feld 'statInSummary' c uebertragen werden: c logical SUM_S1M2 / .false. / c die lokalen Variablen fuer das Einlesen der logicals fuer die Erzeugung c der Tabellen-files der verschiedenen Statistiken, die dann in das Feld c 'createTabelle' uebertragen werden: c logical TAB_S1M2 / .false. / c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Variable fuer den Test, ob 'ACCEL' als batch job laeuft: c (setzt voraus, dass im Falle eines batch jobs das logical c 'running_in_batchmode' definiert ist). INCLUDE '($SSDEF)/NOLIST' INCLUDE '($LNMDEF)/NOLIST' integer status, sys$trnlnm STRUCTURE /ITMLST/ UNION MAP integer*2 BUFLEN integer*2 CODE integer*4 BUFADR integer*4 RETLENADR END MAP MAP integer*4 END_LIST END MAP END UNION END STRUCTURE RECORD /ITMLST/ LNMLIST(2) character*20 running_in_batchmode c=============================================================================== gotFileNr = .false. c Pruefe, ob ACCEL als batch job laeuft: LNMLIST(1).BufLen = Len(RUNNING_IN_BATCHMODE) LNMLIST(1).Code = LNM$_STRING LNMLIST(1).BufAdr = %Loc(RUNNING_IN_BATCHMODE) LNMLIST(1).RetLenAdr = 0 Status = SYS$trnlnm(lnm$M_case_blind, + 'lnm$file_dev','RUNNING_IN_BATCHMODE',,Lnmlist) if (Status.EQ.SS$_NOLOGNAM) then batch_mode = .false. INPUT_LIST = .false. else write(*,*) write(*,*) ' >>>> *******************************************' write(*,*) ' >>>>> logical ''RUNNING_IN_BATCHMODE'' is defined' write(*,*) ' >>>>> => assume ACCEL is run in batch mode' write(*,*) ' >>>> *******************************************' write(*,*) batch_mode = .true. c Pruefe, of 'InputListName' definiert ist. Falls ja, verwende die entsprechende c Eingabeliste. Ansonsten bearbeite ACCEL.INPUT: LNMLIST(1).BufLen = Len(inputListName) LNMLIST(1).Code = LNM$_STRING LNMLIST(1).BufAdr = %Loc(inputListName) LNMLIST(1).RetLenAdr = 0 Status = SYS$trnlnm(lnm$M_case_blind, + 'lnm$file_dev','inputListName',,Lnmlist) if (Status.NE.SS$_NOLOGNAM) then call str$trim(inputListName,inputListName,Length) inputListName = inputListName(1:length) INPUT_LIST = .true. endif c Liess gegebenenfalls zu verwendenden Input-filenamen ein: if (INPUT_LIST) then open(lunRead,file=inputListName//'.INPUT',status='old',iostat=iostat, + defaultfile=readDir) if (iostat.NE.0) then write(*,*) ' Kann '''//inputListName//'.INPUT'' nicht oeffnen' write(*,*) call exit endif ListLength = 0 testRun_ = .false. 10 read(lunRead,'(A)',end=20) inputName read(inputName,*,iostat=iostat) ihelp if (iostat.NE.0) then ListLength = ListLength + 1 goto 10 else if (ihelp.GT.0) then lastOne = ihelp if (lastOne.EQ.1) then write(*,*) 'Es wurden schon alle files aus '''//inputListName//'.INPUT''' write(*,*) 'abgearbeitet!' write(*,*) close(lunRead) call exit endif else gotFileNr = .true. fileNr = -ihelp+1 if (fileNr.EQ.10000) fileNr=9900 endif goto 10 endif 20 if (listLength.EQ.0) then write(*,*) ' no file names found in inputList -> STOP' call exit endif if (lastOne.EQ.0) lastOne=listLength+1 c den Namen des fuer diese Simulation zu verwendenden input-files einlesen: rewind(lunRead) do k = 1, lastOne-2 read(lunRead,*) enddo read(lunRead,'(A)') inputName c die Nummer des jetzt verwendeten input-files sowie (falls schon bekannt) die c (negative) fileNr der Ausgabefile ausgeben: ! bis Listenende weiterblaettern: do k = lastOne, listLength read(lunRead,*) enddo write(lunRead,*) lastOne-1 if (gotFileNr) write(lunRead,*) -fileNr close(lunRead) c gegebenenfalls schon den Namen der Ausgabe-files definieren: if (gotFileNr) then if (fileNr.GE.9900) then TestRun_ = .true. else TestRun_ = .false. endif write(filename(4:7),'(I4)')fileNr if (fileNr.LE.999) write (filename(4:4),'(A1)') '0' if (fileNr.LE. 99) write (filename(5:5),'(A1)') '0' if (fileNr.LE. 9) write (filename(6:6),'(A1)') '0' endif write(*,'(xA,I3,A)')'Verwende',listLength-lastOne+2, + '.letzte INPUT-Datei aus '''//inputListName//'.INPUT'': ' write(*,*) inputName open(lunMessage,file='AC_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:', + status='UNKNOWN',iostat=iostat) write(lunMessage,'(xx,I2)',iostat=iostat) lastOne-1 else open(lunMessage,file='ACCEL.MESSAGE',defaultfile='SYS$SCRATCH:', + status='UNKNOWN',iostat=iostat) endif call date(datum) call time(uhrzeit) write(lunMessage,*,iostat=iostat) ' started on '//datum//' at '//uhrzeit write(lunMessage,*,iostat=iostat) inputname close(lunMessage,iostat=iostat) endif c=============================================================================== c Einlesen der Eingabe-Datei: open(lunREAD,file=inputName,defaultfile=readDir//':.INPUT', + status='OLD',readonly) read(lunREAD,nml=parameter_liste) close(lunREAD) c Einlesen der 'overwrite_default'-Datei: open(lunREAD,file='overwrite_defaults',defaultfile=readDir//':.INPUT', + status='OLD',readonly,iostat=iostat) if (iostat.EQ.0) then write(*,*) ' ##### READING INPUT FROM FILE >> ''OVERWRITE_DEFAULTS.INPUT'' << #####' read(lunREAD,nml=parameter_liste) close(lunREAD) endif write(*,*) if (E0InterFromFile) then ! read E0-Intervalls from File E0-Intervalls.input: open(lunREAD,file='E0-Intervalls',defaultfile=readDir//':.INPUT', + status='OLD',readonly) nE0Inter = 0 5 read(lunREAD,'(A)',iostat=iostat) zeile if (ioStat.EQ.0) then call str$upcase(zeile,zeile) if (index(zeile,'XXXXXXXXX').NE.0) goto 6 if (zeile.NE.' ' .AND. index(zeile,'*').EQ.0 .AND. + index(zeile,'!').EQ.0 .AND. index(zeile,'C').EQ.0) then nE0Inter = nE0Inter + 1 if (nE0Inter.GT.101) then write(*,*) 'you gave more than 100 E0 intervalls' call exit endif read(zeile,*) E0Low(nE0Inter) endif goto 5 endif close(lunREAD) 6 nE0Inter = nE0Inter - 1 do k = 1, nE0Inter write(*,'(x,A,I4,A,F6.3,A,F6.3,A)') 'E0-intervall',k,': [',E0Low(k),',',E0Low(k+1),']' enddo if (nE0Inter.LT.1) then write(*,*) 'found no E0 intervalls in ''E0-INTERVALLS.INPUT''' call exit endif E0_(1) = 1 E0_(2) = nE0Inter E0_(3) = 1 random_energy = 1 lowerE0 = E0Low(1) upperE0 = E0Low(nE0Inter+1) endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Ueberpruefen und Auswerten der Parameter: c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (mappenName.EQ.' ') then write(*,*)' Potentialmappe nicht spezifiziert!' write(*,*)' (Zuweisung fuer ''mappenName'' in ''ACCEL.INPUT'')' write(*,*) write(*,*)' -> STOP' write(*,*) STOP elseif (mappenName.EQ.'2') then mappenName = 'sep92_new' elseif (mappenName.EQ.'3') then mappenName = 'sep92_new' elseif (mappenName.EQ.'4') then mappenName = 'sep92_new' elseif (mappenName.EQ.'5') then mappenName = 'sep92_new' elseif (mappenName.EQ.'6') then mappenName = 'run6_new' elseif (mappenName.EQ.'7') then mappenName = 'run6_new' elseif (mappenName.EQ.'8') then mappenName = 'run6_new' elseif (mappenName.EQ.'9') then mappenName = 'run9' elseif (mappenName.EQ.'10') then mappenName = 'run10' endif c Entfernen von 'leading blanks' aus 'mappenName': indx1 = 1 30 indx = index(mappenName,' ') if (indx.EQ.indx1) then mappenName(indx:indx) = '$' indx1 = indx1+1 goto 30 endif c nimm 'mappenName' bis zum ersten blank oder bis zum Punkt: indx2 = indx indx = index(mappenName,'.') if (indx.NE.0) indx2 = min(indx2,indx) indx2 = indx2-1 mappenName = mappenName(indx1:indx2) nameLength = indx2-indx1+1 c mache 'mappenName' uppercase: call str$upcase(mappenName,mappenName) c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Uebertragen der Schleifenparameter in das Feld 'par': do k = 1,3 par(k,UTarget) = U_Tgt_ (k) par(k,UGuard) = U_Gua_ (k) par(k,UGi1) = U_G1_ (k) par(k,BHelm) = B_Helm_ (k) par(k,BTD) = B_TD_ (k) par(k,mass) = Masse_ (k) par(k,charge) = Ladung_ (k) par(k,ener) = E0_ (k) par(k,yPos) = y0_ (k) par(k,zPos) = z0_ (k) par(k,thetAng) = theta0_ (k) par(k,phiAng) = phi0_ (k) enddo c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Einlesen und Pruefen der zu den Potentialmappen gehoerenden INFO-files: call read_INFOS ! setzt gegebenenfalls das logical 'HVs_from_map' ! und passt par(i,UTarget), par(i,UGuard) und ! par(i,UGi1) an. c Pruefe ob Potentialmappen aneinander stossen: if (xEndMap1.NE.xStartMap2) then write(*,*)' End of map 1 misses start of map 2:' write(*,*)' xEndMap1 = ',xEndMap1 write(*,*)' xStartMap2 = ',xStartMap2 write(*,*)' -> STOP' STOP elseif (xEndMap2.NE.xStartMap3) then write(*,*)' End of map 2 misses start of map 3:' write(*,*)' xEndMap2 = ',xEndMap2 write(*,*)' xStartMap3 = ',xStartMap3 write(*,*)' -> STOP' STOP elseif (xEndMap3.NE.xStartMap4) then write(*,*)' End of map 3 misses start of map 4:' write(*,*)' xEndMap3 = ',xEndMap3 write(*,*)' xStartMap4 = ',xStartMap4 write(*,*)' -> STOP' STOP elseif (xEndMap4.NE.xStartMap5) then write(*,*)' End of map 4 misses start of map 5:' write(*,*)' xEndMap4 = ',xEndMap4 write(*,*)' xStartMap5 = ',xStartMap5 write(*,*)' -> STOP' STOP elseif (xEndMap5.NE.xStartMap6) then write(*,*)' End of map 5 misses start of map 6:' write(*,*)' xEndMap5 = ',xEndMap5 write(*,*)' xStartMap6 = ',xStartMap6 write(*,*)' -> STOP' STOP endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Variable 'artList' auswerten: if (artList.NE.' ') call examine_artList c wurde die Variable 'artList' nicht gesetzt, setze 'UseDecay' auf .false.: if (.NOT.artList_defined) then if (UseDecay) then UseDecay = .false. write(*,1000) 'Myonen-Zerfall nur bei Verwendung von '// + '''ArtList''','UseDecay = .false. gesetzt' flag_message = .true. endif endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Startgebiet und -Koordinate festlegen: if (StartFlaeche.EQ.-1) then if (x0_.LE.0) then x0_ = 0. Startflaeche = 0 Gebiet0 = target elseif (x0_.LE.xPosition_Grid1) then Gebiet0 = upToGrid1 if (x0_.EQ.xPosition_Grid1) Startflaeche = 1 elseif (x0_.LE.xPosition_Grid2) then Gebiet0 = upToGrid2 elseif (x0_.LE.rHeShield) then Gebiet0 = upToHeShield endif x0(1) = x0_ elseif (StartFlaeche.EQ.1) then Gebiet0 = upToGrid2 x0(1) = xPosition_Grid1 elseif (StartFlaeche.EQ.2) then Gebiet0 = upToHeShield x0(1) = xPosition_Grid2 else Startflaeche = 0 Gebiet0 = target x0(1) = xFoil endif c Falls die Anzahl zufallsverteilter Starts <= 0 sein sollte, vergiss die c Zufallsstarts: if (randomStarts.LE.0) then random_energy = 0 random_position = 0 random_winkel = 0 endif c Zufallsverteilung fuer Startenergie? if (random_energy.GE.1 .AND. random_energy.LE.2) then random_E0 = .true. if (random_energy.EQ.1 .AND..NOT.(lowerE0.EQ.0..AND.upperE0.EQ.0.)) then if (lowerE0.GT.upperE0) then help = lowerE0 lowerE0 = upperE0 upperE0 = help endif random_E0_equal = .true. elseif (random_energy.EQ.2 .AND..NOT.(sigmaE0.EQ.0.)) then random_E0_gauss = .true. if (adjustSigmaE0) sigmaE0 = -99 else random_E0 = .false. endif if (.NOT.random_E0_gauss) adjustSigmaE0 = .false. elseif (random_energy.NE.0) then write(*,*) write(*,*) 'random_energy = ',random_energy,' is not defined' write(*,*) '-> STOP' write(*,*) STOP endif c Zufallsverteilung fuer Startpositionen? if (random_position.GE.1 .AND. random_position. LE.4) then random_pos = .true. ! setze gegebenenfalls Defaultwerte ein. Falls nicht, pruefe ob ! Startortverteilung innerhalb der Folienflaeche liegt: if (startBreite.LT.0.) then startBreite = 2.*dy_Foil else if (startBreite.GT.2.*dy_Foil) then write(*,*) write(*,*) 'Startbreite ist groesser als Folienbreite:' write(*,*) 'Startbreite, Starthoehe = ',startBreite,startHoehe write(*,*) 'Folienbreite, Folienhoehe = ',2.*dy_Foil,2.*dz_Foil write(*,*) call exit endif endif if (startHoehe .LT.0.) then startHoehe = 2.*dz_Foil else if (startHoehe.GT.2.*dz_Foil) then write(*,*) write(*,*) 'Starthoehe ist groesser als Folienhoehe:' write(*,*) 'Startbreite, Starthoehe = ',startBreite,startHoehe write(*,*) 'Folienbreite, Folienhoehe = ',2.*dy_Foil,2.*dz_Foil write(*,*) call exit endif endif if (startRadius.LT.0.) startRadius = 20. sigmaPosition = abs(sigmaPosition) if (random_position.EQ.1 .AND. + .NOT.(StartBreite.EQ.0 .AND. StartHoehe.EQ.0)) then random_y0z0_equal = .true. elseif (random_position.EQ.2 .AND. .NOT.StartRadius.EQ.0) then random_r0_equal = .true. elseif (random_position.EQ.3 .AND. .NOT.sigmaPosition.EQ.0. + .AND. .NOT.(StartBreite.EQ.0 .AND. StartHoehe.EQ.0)) then random_y0z0_Gauss = .true. elseif (random_position.EQ.4 .AND. .NOT.StartRadius.EQ.0. + .AND. .NOT.sigmaPosition.EQ.0.) then random_r0_Gauss = .true. else random_pos = .false. endif elseif (random_position.NE.0) then write(*,*) write(*,*) 'random_position = ',random_position,' is not defined' write(*,*) '-> STOP' write(*,*) STOP endif c Zufallsverteilung fuer Startwinkel? if (random_winkel.GE.1 .AND. random_winkel.LE.2) then random_angle = .true. if (random_winkel.EQ.1) then random_lambert = .true. elseif (random_winkel.EQ.2 .AND. .NOT.sigmaWinkel.EQ.0.) then random_gauss = .true. else random_angle = .false. endif elseif (random_winkel.NE.0) then write(*,*) write(*,*) 'random_winkel = ',random_winkel,' is not defined' write(*,*) '-> STOP' write(*,*) STOP endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Durchlaufzahl fuer die 'Zufallsschleife' richtig setzen: if (random_E0.OR.random_pos.OR.random_angle) then par(2,0) = randomStarts ! (Default = 1) endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c die Parameter fuer die Schleifen setzen und die Gesamtzahl startender c Projektile berechnen: call adjustLoops imonitor = min(imonitor,n_par(0)) c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (n_par(0).EQ.1) OneStartPerLoop = .true. SchleifenZahl = GesamtZahl/n_par(0) if (SchleifenZahl.EQ.1) OneLoop = .true. c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c n_par der unbenutzten Schleifen auf 0 setzen (wird von PHYSICA benoetigt): if (.NOT.freeGuard) then n_par(UGuard) = 0 endif if (random_E0 .AND. par(2,ener).EQ.0 .OR. E0InterFromFile) then c n_par(ener) = 0 ener_offset = .false. endif if (random_pos .AND. + par(1,yPos).EQ.0 .AND .par(2,yPos).EQ.0. .AND. + par(1,zPos).EQ.0 .AND .par(2,zPos).EQ.0. ) then n_par(yPos) = 0 n_par(zPos) = 0 pos_offset = .false. endif if (random_angle .AND. + par(1,thetAng).EQ.0 .AND .par(2,thetAng).EQ.0. .AND. + par(1,phiAng).EQ.0 .AND .par(2,phiAng).EQ.0. ) then n_par(thetAng) = 0 n_par(phiAng) = 0 angle_offset = .false. endif if (.NOT.random_angle .AND. + par(1,thetAng).EQ.0 .AND .par(2,thetAng).EQ.0. ) then n_par(phiAng) = 0 endif if (artlist_defined) then n_par(mass) = 0 endif if (par(1,BHelm) .EQ.0. .AND. par(2,BHelm) .EQ.0.) n_par(BHelm) = 0 if (par(1,BTD) .EQ.0. .AND. par(2,BTD) .EQ.0.) n_par(BTD) = 0 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c falls ausser den fuer Mutrack notwendigen Goessen vom Benutzer zusaetzliche c Groessen verlangt werden, setze auch 'NTP_Misc' auf .true. (-> StartNr, c SchleifenNr, Mappe, Steps). if (NTP_40mm.AND.scaleFactor.NE.1.) then write(*,1000) 'NTP_40mm nur bei ScaleFactor = 1 ', + 'NTP_40m = .false. gesetzt' flag_message = .true. endif if (NTP_Start .OR. NTP_Stop .OR. NTP_40mm) NTP_Misc = .true. c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Bei Debug grundsaetzlich die RunNummern von 9900 bis 9999 verwenden (TestRun). c Bei Debug soll volles Logfile erstellt werden. if (DEBUG) then if (debug_Anzahl.EQ.0) then write(*,1000) 'debug_Anzahl = 0','es werden keine'// + 'DEBUG-Informationen ausgegeben' flag_message = .true. debug = .false. else if (debug_Anzahl.GT.n_par(0)) debug_Anzahl = n_par(0) TestRun = .true. if (n_outWhere.LT.1) then n_outWhere = 1 elseif (n_outWhere.GT.2) then n_outWhere = 2 endif endif endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c welche Ausgabekanaele sollen fuer das Summary durchlaufen werden? if (n_outWhere.NE.0) then if (n_outWhere.LT.0 .OR. n_outWhere.GT.3) then write(*,*) write(*,*) 'Der Bereich von n_outWhere ist auf '// + '[0,3] eingeschraenkt!' write(*,*) STOP endif if (n_outWhere.LE.2) LogFile = .true. ! volles Summary-File indx1 = int((n_outWhere+1)/2) ! = 1,1,2 fuer n_outWhere=1,2,3 indx2 = int((n_outWhere+2)/2) ! = 1,2,2 fuer n_outWhere=1,2,3 endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c wenn keine Ausgabe des LOG-files vorgesehen ist, aber das PHYSICA-file c und/oder das NTP-file erzeugt werden sollen, dann ist zumindest die c Minimalversion des LOG-files zu erstellen: if (.NOT.LogFile .AND. (createPhysTab.OR.NTP_Misc)) then smallLogFile = .true. ! Minimalversion erzeugen indx1 = 1 if (n_outWhere.EQ.0) indx2 = 1 endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Uebertragen der logicals fuer die im Logfile auszugebenden Statistiken: c statInSummary(Nr_S1M2) = SUM_S1M2 c Uebertragen der logicals fuer die zu erzeugenden Tabellen: c createTabelle(Nr_S1M2) = TAB_S1M2 c Falls weder grosses noch kleines Summary ausgegeben werden soll, und auch die c Bildschirmausgabe unterbleibt, setze alle statInSummary auf .false.: if (.NOT.(LogFile .OR. smallLogFile) .AND. n_outWhere.LT.2) then do k = 1, stat_Anzahl statInSummary(k) = .false. enddo endif c Falls (abgesehen von der PHYSICA-Tabelle) irgendwelche Tabellen c gewuenscht werden, setze 'createTabellen' auf .true.: do k = 1, Stat_Anzahl if (createTabelle(k)) then createTabellen = .true. endif enddo c Sollte pro Schleife nur ein Teilchenstart erfolgen oder umgekehrt ausser c der 'Zufalls-Schleife' keine anderen Schleife durchlaufen werden, dann c unterlasse die Ausgabe von Tabellen. if (OneStartPerLoop.OR.OneLoop) then if (createPhysTab) then flag = .true. if (OneLoop) then write(*,1000) 'nur eine Schleife', + 'PHYSICA-Tabelle wird nicht erzeugt' else write(*,1000) 'nur ein Start pro Schleife', + 'PHYSICA-Tabelle wird nicht erzeugt' endif flag_message = .true. createPhysTab = .false. else flag = .false. endif if (createTabellen) then if (flag) then write(*,1000) ' ', + 'Tabellen-files werden nicht erzeugt' elseif (OneLoop) then write(*,1000) 'nur eine Schleife', + 'Tabellen-files werden nicht erzeugt' else write(*,1000) 'nur ein Start pro Schleife', + 'Tabellen-files werden nicht erzeugt' endif flag_message = .true. do k = 1, Stat_Anzahl createTabelle(k) = .false. enddo createTabellen = .false. endif endif if (n_outWhere.LT.0) n_outWhere = 0 c falls im Summary irgendwelche Statistiken ausgegeben werden sollen, setze c 'statsInSummary' auf .true.: do k = 1, stat_Anzahl if (statInSummary(k)) then statsInSummary = .true. endif enddo c pruefe, fuer welche Groessen Statistiken gefuehrt werden muessen, und setze c das jeweilige 'statNeeded' auf .true.: if (createPhysTab) then ! alle Statistiken benoetigt! do k = 1, Stat_Anzahl statNeeded(k) = .true. enddo else ! einzelne Statistiken benoetigt? do k = 1, Stat_Anzahl if (createTabelle(k).OR.statInSummary(k)) then statNeeded(k) = .true. endif enddo endif c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1000 format(x,A,T36,'->',T40,A) c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c falls Parameter abgeaendert worden sind, hole Bestaetigung ein: if (.NOT.(NTP_Misc.OR.createPhysTab.OR.createTabellen.OR. + graphics.OR.LogFile.OR.smallLogFile.OR.n_outWhere.GT.1)) then write(*,*) write(*,*)' > You don''t want to have a logfile' write(*,*)' > You don''t desire a display on the screen.' write(*,*)' > You do not want to have a nice graphics of ', + 'the calculated trajectories.' write(*,*)' > You don''t ask me to create a Ntuple or a ', + 'PHYSICA readable file.' write(*,*)' > And you do not long for having the result in ', + 'tabulated form.' write(*,*) write(*,*)' HEY MAN, YOU ARE NOT PRODUCING ANY OUTPUT!!' write(*,*)' ARE YOU SURE YOU WANT ME TO WORK JUST FOR FUN?' write(*,*) flag_message = .true. endif if (flag_message .AND. .NOT.BATCH_MODE) then write(*,1010) accept 1011, antwort 1010 format(' ok? ( = ABBRUCH)',T36'-> ',$) 1011 format(A5) ! bis zu vier Leerzeichen vor Buchstaben werden akzeptiert k = 0 40 k = k+1 if (antwort(k:k).eq.' ' .AND. k.LE.4) then goto 40 elseif (antwort(k:k).eq.'n' .or. antwort(k:k).eq.'N' .or. + antwort(k:k).eq.'a' .or. antwort(k:k).eq.'A' .or. + antwort(k:k).eq.'c' .or. antwort(k:k).eq.'C' ) then write(*,*) STOP endif endif c bei Verwendung von 'input_list' korrigiere noetigenfalls den Wert von c 'testRun': if (input_list.AND.gotFileNr) testRun = testRun_ c falls kein Summary-File erstellt wird, braucht auch die 'T E S T - R U N' - c Meldung nicht auf dem Bildschirm erscheinen: if (.NOT.(logFile.OR.smallLogFile)) testRun = .false. c Bedingungen fuer die Ausgabe der Prozentzahl schon gerechneter Teilchen c pruefen: if (.NOT.BATCH_MODE .AND. n_par(0).GE.50 .AND. n_outWhere.GE.2) then log_percent = .true. endif if (batch_mode) graphics = .false. END c=============================================================================== OPTIONS /EXTEND_SOURCE SUBROUTINE adjustLoops c ====================== IMPLICIT NONE INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' integer k real value, help, factor, step GesamtZahl=1 do k = 0 , par_Anzahl ! k=0: 'Zufalls-Schleife' if (par(2,k).NE.1.e10) then ! wurde maxWert vorgegeben? if (par(2,k).EQ.par(1,k).OR.par(3,k).EQ.0.) then par(3,k) = 1. ! step = 0 vermeiden else ! wurde step vorgegeben? if (par(3,k).EQ.-1.e10) par(3,k)=par(2,k)-par(1,k) endif else par(2,k) = par(1,k) par(3,k) = 1. endif ! es kam vor, dass wegen der endlichen Genauigkeit numerischer Zahlen ! die letzte Schleife nicht durchlaufen wurde. Deshalb wurden folgende ! Befehlszeilen eingebaut: factor = 1 step = par(3,k) 10 do help = par(1,k), par(2,k), step value = help enddo if (abs((value-par(2,k))/step) .GT. 0.1) then factor = factor - 0.00000003 step = par(3,k) * factor goto 10 endif par(3,k) = step n_par(k) = int((par(2,k)-par(1,k)+par(3,k))/par(3,k) +.5) ! so werden laut if (n_par(k).LE.0) n_par(k)=1 ! library die Anzahlen der Durchlaeufe berechnet 99 GesamtZahl = GesamtZahl * n_par(k) c setzte Parameter (mit hoeherer Codenummer!), deren Variation sinnlos waere c auf Null: if (k.EQ.ener .AND. .NOT.random_E0 .AND. + n_par(ener).LE.1 .AND. par(1,ener).EQ.0. ) then par(1,thetang) = 0. par(2,thetang) = 0. par(1,phiAng) = 0. par(2,phiAng) = 0. random_angle = .false. random_lambert = .false. random_gauss = .false. elseif (k.EQ.thetAng .AND. + n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. ) then par(1,phiAng) = 0. par(2,phiAng) = 0. endif enddo END c===============================================================================