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

1021 lines
29 KiB
Fortran
Raw Blame History

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