817 lines
26 KiB
Fortran
817 lines
26 KiB
Fortran
#include "geant321/pilot.h"
|
|
c-----------------------------------------------
|
|
c ~/mc/geant/src/lemsr/geant_lemsr_main.F
|
|
c-----------------------------------------------
|
|
c
|
|
program geant_lemsr
|
|
c
|
|
c Program very much "grown", so many things could be programmed in
|
|
c a better way...
|
|
c
|
|
c program to simulate the response of the low energy muon muSR
|
|
c detector setup at PSI. Some parts are taken from Nai_simul.for.
|
|
c It is intended to steer the simulation by format free inputs
|
|
c (routine gffgo); this can be done interactively or data sets
|
|
c can be read from file.
|
|
c
|
|
c Uses Run11 setup geometry.
|
|
c
|
|
c For precession: at the moment use the total TOF for the calculation
|
|
c of the precession angle. When the muon is started as particle code=500
|
|
c and upstream of the target, the precession is calculated as if the
|
|
c muon is flying all the time through the B-field.
|
|
c
|
|
c TP 18-Jan-1999 PSI
|
|
c
|
|
c TP, 4-Feb-1999: CW Ntuples
|
|
c TP, 9-Feb-1999: store energy loss per detector in NTuple
|
|
c TP,16-Feb-1999: time in NTUPLE as REAL*4 instead of INTEGER
|
|
c TP,26-Feb-1999: If particles start upstream gaussian divergence of
|
|
c beam now possible.
|
|
c
|
|
c*****************************************************************************
|
|
c
|
|
c TP, 11-May-2000 PSI
|
|
c Windows NT 4.0 version; uses include files which
|
|
c I created manually from the VMS GEANT321.TLB text library.
|
|
c
|
|
c TP, 15-Sep-2000 PSI
|
|
c Unix version Used fsplit to separate program into
|
|
c subroutines and functions.
|
|
c
|
|
c
|
|
c TP, 05-Apr-2001 PSI
|
|
c Unix, NT, and Linux (to be checked)
|
|
c version; use the Compaq Fortran fpp
|
|
c precompiler on NT
|
|
c
|
|
c 17-Dec-2002 TP extend bfield array to account for different
|
|
c polarization in sample (=bfield(5))
|
|
c gaussian muon momentum distribution possible
|
|
c via sets(8) and sets(9):
|
|
c sigma_p = p0 * (sets(8)/100.+sets(9)/1000.)
|
|
c
|
|
c------------------------------------------------------------------
|
|
c
|
|
implicit none
|
|
c
|
|
c include some files from $CERN_ROOT/include/
|
|
c
|
|
c to avoid explicitly including the gt***.inc file
|
|
c define CERNLIB_TYPE; the gt***.inc files are then
|
|
c automatically included in the gc***.inc files.
|
|
c
|
|
#define CERNLIB_TYPE
|
|
#include "geant321/gclist.inc"
|
|
#include "geant321/gcflag.inc"
|
|
#include "geant321/gcphys.inc"
|
|
#include "geant321/gccuts.inc"
|
|
#include "geant321/gckine.inc"
|
|
c
|
|
#include "cwn.inc"
|
|
#include "common.inc"
|
|
c
|
|
c
|
|
c the particle definition (variable IPART): see GEANT manual CONS300-1
|
|
c
|
|
c particle IPART
|
|
c
|
|
c gamma 1
|
|
c positron 2
|
|
c electron 3
|
|
c neutrino 4
|
|
c muon+ 5
|
|
c muon- 6
|
|
c pion0 7
|
|
c pion+ 8
|
|
c pion- 9
|
|
c ...
|
|
c
|
|
integer*4 NG, NH
|
|
parameter (NG = 2000000)
|
|
parameter (NH = 1000000)
|
|
integer*4 ipawc,q
|
|
integer*4 iwktyp
|
|
integer*4 iquest(100)
|
|
c
|
|
common /quest/iquest !needed to get enough space for NTUPLE
|
|
common /pawc/ipawc(NH)
|
|
common /gcbank/q(NG)
|
|
c
|
|
c parameter for drawing (used in GEANT routine GDRAW)
|
|
c
|
|
real*4 gdtheta,gdphi,gdpsi
|
|
real*4 gdx0,gdy0,gdsx,gdsy
|
|
c
|
|
real*4 xn,yn,scal,r(2)
|
|
integer*4 i
|
|
c
|
|
c for opening NTUPLE file and NTUPLE
|
|
c
|
|
integer*4 istat
|
|
character*72 ntfile
|
|
c
|
|
c the run number copied from GEAN variable IDRUN
|
|
c
|
|
character*4 runno
|
|
c
|
|
c for graphic output to PostScript file
|
|
c
|
|
character*72 psfile
|
|
c
|
|
integer*4 lunin /4/
|
|
integer*4 ipres
|
|
real*4 ub(1)
|
|
c
|
|
c-----------------------------------------------------------------
|
|
c
|
|
c flags for NTUPLE variable definitions
|
|
c
|
|
c 'init' write initial parameter to NT
|
|
c 'code' initial particle ID to NT
|
|
c 'endp' end position and energy of e+
|
|
c 'time' t-mcp and t-sci
|
|
c 'scip' position when particle hits inner Sc.
|
|
c 'scie' energy loss of particles in inner sc.
|
|
c 'scop' position when particle hits outer Sc.
|
|
c 'scoe' energy loss of particles in outer sc.
|
|
c 'flag' Vol. numbers and particle codes; needed to get the single
|
|
c decay spectra
|
|
c 'nhit' Number of Hits in detectors MCP, SCI and SCO
|
|
c 'posm' Generated momentum of decay positron
|
|
c 'mcpe' energy loss in MCP detector
|
|
c 'allv' use all possible NT variables
|
|
c 'ltrb' energy loss in single detectors (inner and outer separate)
|
|
c
|
|
integer*4 ntvar(20) ! new data card defined by CALL FFKEY to
|
|
c ! select NTuple variables
|
|
c
|
|
logical*1 l_init_par /.false./
|
|
logical*1 l_code /.false./
|
|
logical*1 l_endp /.false./
|
|
logical*1 l_time /.false./
|
|
logical*1 l_scip /.false./
|
|
logical*1 l_scie /.false./
|
|
logical*1 l_scop /.false./
|
|
logical*1 l_scoe /.false./
|
|
logical*1 l_flag /.false./
|
|
logical*1 l_nhit /.false./
|
|
logical*1 l_posm /.false./
|
|
logical*1 l_mcpe /.false./
|
|
logical*1 l_allv /.false./
|
|
logical*1 l_ltrb /.false./
|
|
c
|
|
c------------------------------------------------------------------
|
|
c
|
|
c start of program code
|
|
c
|
|
c------------------------------------------------------------------
|
|
c
|
|
c general initializations
|
|
c
|
|
c initial random generator seeds
|
|
c
|
|
ix1 = 343156821
|
|
c
|
|
do i = 1, 9
|
|
percent(i) = 0
|
|
enddo
|
|
c
|
|
l_mcp2 = .false.
|
|
l_mcpa = .false.
|
|
l_mcps = .false.
|
|
l_samp = .false.
|
|
l_cryo = .false.
|
|
l_crsh = .false.
|
|
l_efla = .false.
|
|
l_run11 = .false.
|
|
samp_mat = ' '
|
|
c
|
|
l_pos = .false.
|
|
l_ele = .false.
|
|
l_gam = .false.
|
|
c
|
|
c-----------------------------------------
|
|
c
|
|
call gzebra(NG)
|
|
call hlimit(-NH)
|
|
call ginit ! initialize GEANT variables
|
|
call gzinit ! initialize GEANT data structure
|
|
call gpart ! GEANT standard particles
|
|
call gspart(500, 'muon+', 5, 0.1056584, 1., 2.19703E-6, ub, 1)
|
|
c
|
|
c------------------------------------------------------------------
|
|
c
|
|
c open parfile in any case, the user can decide if data should
|
|
c be read from parfile or entered by terminal
|
|
c
|
|
open(lunin, file=PARFILE, status='OLD',err=1003)
|
|
write(6,*) ' '
|
|
write(6,*) '%GEANT-LEMSR-I- Successfully opened data card file '
|
|
write(6,*)
|
|
write(6,*) PARFILE
|
|
c
|
|
c read data cards
|
|
c
|
|
write(6,*) ' '
|
|
write(6,*) 'Type in the data cards now... finish with ''STOP'''
|
|
write(6,*) '--------------------------------------------------'
|
|
write(6,*) ' '
|
|
write(6,*) 'READ 4 : reads input data from '//
|
|
1 'LUN=4--> file '
|
|
write(6,*) ' '
|
|
write(6,*) PARFILE
|
|
write(6,*) ' '
|
|
c write(6,*) 'RUNG 24 : user run number'
|
|
c write(6,*) ' '
|
|
c write(6,*) 'PLOT 0 : no graphical output'
|
|
c write(6,*) 'PLOT 1 : output on workstation only'
|
|
c write(6,*) 'PLOT 2 : output on workstation and metafile'
|
|
c write(6,*) ' '
|
|
c write(6,*) 'SETS 2 0 : particle is e+(=2), michel '//
|
|
c 1 'distributed'
|
|
c write(6,*) ' start MCP2 detector'
|
|
c write(6,*) 'SETS 2 -74 27 5 1 : beam positron with 27.51 MeV/c '//
|
|
c 1 'at z=-74cm'
|
|
c write(6,*) 'SETS 5 -74 2 0 0 : beam muon(=5) with 2.00 MeV/c'
|
|
c write(6,*) ' particle started 74cm upstream of'
|
|
c write(6,*) ' of center of MCP2 tube.'
|
|
c write(6,*) ' '
|
|
c write(6,*) 'TRIG 100 : 100 events to be generated'
|
|
c write(6,*) ' '
|
|
c write(6,*) 'GEOM ''mcp2'' ''samp'' : mcp2 and cryo are mounted.'
|
|
c write(6,*) ' '
|
|
c write(6,*) 'SPAR '' e+'' '' e-'' '' gam'' : select sec. '//
|
|
c 1 'particles.'
|
|
c write(6,*) ' '
|
|
c write(6,*) 'BFIE 0. 0. 100. 90. : Sample B-field (Gauss), '//
|
|
c 1 'Bx, By, Bz,'
|
|
c write(6,*) ' and Polarization = 90 % here.'
|
|
c write(6,*)
|
|
c write(6,*) 'NTVA ''init'' ''time'' ''flag'' : define NT '//
|
|
c 1 'variables.'
|
|
c write(6,*) 'See geant_lemsr.input for more information.'
|
|
c write(6,*)
|
|
c write(6,*) 'View 1 Thet Phi Psi u0 v0 10*scal_x 10*scal_y : '//
|
|
c 1 'for graphical output'
|
|
c write(6,*) 'Def. 60 40 0 10 10 2 2'
|
|
c write(6,*) ' '
|
|
c
|
|
c---------------------------------------------------------------
|
|
c
|
|
c define new data card for particles
|
|
c
|
|
call ffkey('SPAR', lspar, 10, 'M')
|
|
c
|
|
c define new data card for magnetic field components
|
|
c
|
|
call ffkey('BFIE', bfield, 5, 'R')
|
|
c
|
|
c define new data card for NTUPLE variables
|
|
c
|
|
call ffkey('NTVA', ntvar, 20, 'M')
|
|
c
|
|
c read data card
|
|
c
|
|
call gffgo
|
|
c
|
|
close(lunin)
|
|
c
|
|
write(6,*) ' '
|
|
write(6,*) '%GEANT-LEMSR-I- Closed file ', PARFILE
|
|
write(6,*)
|
|
c
|
|
write(6,*) 'B-field components Bx, By, Bz = ', bfield(1),
|
|
1 bfield(2), bfield(3)
|
|
write(6,*) ' '
|
|
write(6,*) 'Initial muon polarization = ', bfield(4),' %.'
|
|
write(6,*)
|
|
c
|
|
if ( bfield(1) .ne. 0. ) then
|
|
write(6,*) '******************************************'
|
|
write(6,*) ' '
|
|
write(6,*) 'GEANT-LEMSR-E- B_x not yet implemented...'
|
|
write(6,*) 'Sorry, - - - - > E X I T'
|
|
write(6,*) ' '
|
|
write(6,*) '******************************************'
|
|
call exit
|
|
endif
|
|
if ( bfield(2) .ne. 0. .and. bfield(3) .ne. 0. ) then
|
|
write(6,*) '******************************************'
|
|
write(6,*) ' '
|
|
write(6,*) 'GEANT-LEMSR-E- B_y >0 and B_z >0 not yet '//
|
|
1 'implemented...'
|
|
write(6,*) 'Sorry, - - - - > E X I T'
|
|
write(6,*) ' '
|
|
write(6,*) '******************************************'
|
|
call exit
|
|
endif
|
|
c
|
|
if ( lsets(2) .ne. 0 .and. lsets(7) .ne. 1) then
|
|
write(6,*) ' '
|
|
write(6,*) 'particles of type ',lsets(1),' start at z0 = ',
|
|
1 lsets(2)
|
|
write(6,*) ' '
|
|
else if ( lsets(7) .eq. 1 ) then
|
|
write(6,*) ' '
|
|
write(6,*) 'particles of type ',lsets(1),' start at z0 '//
|
|
1 'read from file'
|
|
write(6,*) ' '
|
|
else
|
|
write(6,*) ' '
|
|
write(6,*) 'particles of type ',lsets(1),' start at z0 = '//
|
|
1 '1.40002 cm.'
|
|
write(6,*) ' '
|
|
endif
|
|
c
|
|
c-------------------------------------
|
|
c
|
|
c look for particles to be created during tracking
|
|
c
|
|
ipres = 0
|
|
call glook(' e+',lspar,10,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_pos = .true.
|
|
write(6,*) ' '
|
|
write(6,*) 'secondary particle: e+...'
|
|
endif
|
|
call glook(' e-',lspar,10,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_ele = .true.
|
|
write(6,*) 'secondary particle: e-...'
|
|
endif
|
|
call glook(' gam',lspar,10,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_gam = .true.
|
|
write(6,*) 'secondary particle: gamma...'
|
|
endif
|
|
c
|
|
c------------------------------------------------------------
|
|
c
|
|
c now look for geometrical setup variables
|
|
c
|
|
call glook('mcp2',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_mcp2 = .true.
|
|
write(6,*) 'Setup with: MCP2'
|
|
endif
|
|
c
|
|
call glook('mcpa',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_mcpa = .true.
|
|
write(6,*) 'Setup with: MCP2 anode and support ring'
|
|
endif
|
|
c
|
|
call glook('ru11',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_run11 = .true.
|
|
if ( l_mcp2 .or. l_mcpa ) then
|
|
write(6,*) 'Setup with: MCP2 Run 11 geometry, delay '//
|
|
1 'line anode'
|
|
endif
|
|
else
|
|
if ( l_mcp2 .or. l_mcpa ) then
|
|
write(6,*) 'Setup with: MCP2 Run 10 geometry, WSZ anode'
|
|
endif
|
|
endif
|
|
c
|
|
call glook('mcps',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_mcps = .true.
|
|
write(6,*) 'Setup with: MCP2 stainless steel vacuum tube'
|
|
endif
|
|
c
|
|
call glook('samp',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_samp = .true.
|
|
write(6,*) 'Setup with: sample holder'
|
|
endif
|
|
c
|
|
call glook('saal',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
samp_mat = 'saal'
|
|
if ( l_samp ) then
|
|
write(6,*) 'Setup with: Al - sample holder'
|
|
endif
|
|
else
|
|
if ( l_samp ) then
|
|
write(6,*) 'Setup with: Cu - sample holder'
|
|
endif
|
|
endif
|
|
call glook('cryo',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_cryo = .true.
|
|
write(6,*) 'Setup with: cryostat'
|
|
endif
|
|
c
|
|
call glook('crsh',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_crsh = .true.
|
|
write(6,*) 'Setup with: He shield'
|
|
endif
|
|
c
|
|
call glook('efla',lgeom,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_efla = .true.
|
|
write(6,*) 'Setup with: 100 CF flange at the end'
|
|
endif
|
|
c
|
|
c----------------------------------------------------
|
|
c
|
|
c look for NT variables
|
|
c
|
|
call glook('init', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_init_par = .true.
|
|
write(6,*) 'NT variable: initial position and momenta.'
|
|
endif
|
|
c
|
|
call glook('code', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_code = .true.
|
|
write(6,*) 'NT variable: Code of primary particle.'
|
|
endif
|
|
c
|
|
call glook('endp', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_endp = .true.
|
|
write(6,*) 'NT variable: End position and end energy of e+.'
|
|
endif
|
|
c
|
|
call glook('time', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_time = .true.
|
|
write(6,*) 'NT variable: t-MCP2 and t-SCI.'
|
|
endif
|
|
call glook('scip', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_scip = .true.
|
|
write(6,*) 'NT variable: Position of particle when '//
|
|
1 'hitting inner Sc..'
|
|
endif
|
|
c
|
|
call glook('scie', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_scie = .true.
|
|
write(6,*) 'NT variable: Energy deposited in inner Sc.'
|
|
endif
|
|
c
|
|
call glook('scop', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_scop = .true.
|
|
write(6,*) 'NT variable: Position of particle when '//
|
|
1 'hitting outer Sc..'
|
|
endif
|
|
c
|
|
call glook('scoe', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_scoe = .true.
|
|
write(6,*) 'NT variable: Energy deposited in outer Sc.'
|
|
endif
|
|
c
|
|
call glook('flag', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_flag = .true.
|
|
write(6,*) 'NT variable: Volume number and particle codes.'
|
|
write(6,*) 'Note: the Vol. No. is necessary to get '//
|
|
1 'single decay spectra.'
|
|
endif
|
|
c
|
|
call glook('nhit', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_nhit = .true.
|
|
write(6,*) 'NT variable: Hits per Track in MCP, Sci Sco.'
|
|
endif
|
|
c
|
|
call glook('posm', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_posm = .true.
|
|
write(6,*) 'NT variable: inital e+ momentum.'
|
|
endif
|
|
c
|
|
call glook('mcpe', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_mcpe = .true.
|
|
write(6,*) 'NT variable: Energy deposited in MCP2.'
|
|
endif
|
|
c
|
|
call glook('allv', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_allv = .true.
|
|
write(6,*) 'NT variable: all variables.'
|
|
endif
|
|
c
|
|
call glook('ltrb', ntvar,20,ipres)
|
|
if ( ipres .ne. 0 ) then
|
|
l_ltrb = .true.
|
|
write(6,*) 'NT variable: energies deposited in single '//
|
|
1 'scintill.'
|
|
endif
|
|
c
|
|
c----------------------------------------------------
|
|
c
|
|
write(runno,'(I4)',err=1002) idrun ! copy run number to string
|
|
c
|
|
if ( lsets(2) .ne. 0 .and. lsets(7) .ne. 1) then
|
|
if ( lsets(3) .gt. 0 ) then
|
|
pkine(1) = float(lsets(3)) + float(lsets(4))/10. +
|
|
1 float(lsets(5))/100.
|
|
else
|
|
pkine(1) = float(lsets(3)) - float(lsets(4))/10. -
|
|
1 float(lsets(5))/100.
|
|
endif
|
|
write(6,'(a,1x,f10.4)') ' %GEANT-LEMSR-I- beam momentum '//
|
|
1 'set to ', pkine(1)
|
|
endif
|
|
if ( lsets(6) .ne. 0 ) then
|
|
write(6,*) ' '
|
|
write(6,*) 'Gaussian beam divergence set to (degree) ',
|
|
1 lsets(6)
|
|
write(6,*) ' '
|
|
endif
|
|
c
|
|
c define volumes and detectors
|
|
c
|
|
call ugeom
|
|
c
|
|
c compute the cross-sections for the different tracking media
|
|
c
|
|
call gphysi
|
|
c
|
|
c make MARS invisible
|
|
c
|
|
call gsatt('MARS','SEEN',0)
|
|
c
|
|
call ggclos ! end of the geometry, must be called
|
|
c
|
|
c print some information about volumes and tracking media on screen
|
|
c
|
|
c call gprint('VOLU',0)
|
|
c call gptmed(0)
|
|
c call gpmate(17)
|
|
c call gpmate(18)
|
|
c
|
|
c-----------------------------------------------------------------------------
|
|
c
|
|
c from GEXAM.FOR example :
|
|
c
|
|
c the card PLOT is used in the following way:
|
|
c no PLOT card --> LPLOT(1)=0 --> no graphic output
|
|
c PLOT 1 --> LPLOT(1)=1 --> plotting onto workstation
|
|
c PLOT 2 --> LPLOT(1)=2 --> plottinig onto workstation
|
|
c and PostScript file
|
|
if (lplot(1) .gt. 0) then
|
|
c
|
|
if ( lview(1) .eq. 1 ) then
|
|
gdtheta = lview(2)
|
|
gdphi = lview(3)
|
|
gdpsi = lview(4)
|
|
gdx0 = lview(5)
|
|
gdy0 = lview(6)
|
|
gdsx = lview(7)/10.
|
|
gdsy = lview(8)/10.
|
|
else
|
|
gdtheta = 60.
|
|
gdphi = 40.
|
|
gdpsi = 0.
|
|
gdx0 = 10.
|
|
gdy0 = 10.
|
|
gdsx = 0.2
|
|
gdsy = 0.2
|
|
endif
|
|
c
|
|
c
|
|
call iginit(0) ! init HIGZ
|
|
c
|
|
c ask for worktsation type
|
|
c this defines the geometry of the X11 window, according to
|
|
c HIGZ_WINDOWS.DAT
|
|
c
|
|
write(6,'(''0Enter the workstation type : '')')
|
|
read(5,*) iwktyp
|
|
call hplint(iwktyp)
|
|
call igset('2BUF',11.)
|
|
c
|
|
if (lplot(1) .gt. 1) then
|
|
c
|
|
c open graphics output file
|
|
c
|
|
psfile = OUT_DIR//'geant_lemsr_'//runno//'.ps'
|
|
open(unit=10, file=psfile, status='NEW',
|
|
1 form='FORMATTED',
|
|
2 access='SEQUENTIAL', err=1001)
|
|
|
|
write(6,*) '%GEANT-LEMSR-I- succesfully opened '//
|
|
1 'metafile '
|
|
write(6,*)
|
|
write(6,*) psfile
|
|
c
|
|
c open and activate workstation for metafile output
|
|
c workstation ID = 5
|
|
c goes to file LUN = 10
|
|
c type = -4112 = PostScript, Landscape, A4 (--> HIGZ manual)
|
|
c
|
|
call iopwk(5, 10, -4112)
|
|
call iacwk(5)
|
|
c
|
|
c find out and select the appropriate transformation and viewport
|
|
c
|
|
call igqwk(5,'MXDS',r)
|
|
xn = min( 1., r(1)/r(2) )
|
|
yn = min( 1., r(2)/r(1) )
|
|
call isvp( 5, 0., xn, 0., yn)
|
|
scal = 20. / min( xn, yn )
|
|
call iswn( 5, 0., scal, 0., scal)
|
|
call iselnt(5)
|
|
endif ! if LPLOT(1) .GT. 1
|
|
c
|
|
c initialize the GEANT's drawing package before the first plot
|
|
c
|
|
call gdinit
|
|
c
|
|
c draw the chamber
|
|
c
|
|
call gdraw('MARS',gdtheta,gdphi,gdpsi,gdx0,gdy0,gdsx,gdsy)
|
|
call gdaxis(-10.,15.,-20.,8.)
|
|
call gdscal(gdx0, gdy0)
|
|
endif ! IF LPLOT(1) .GT. 0
|
|
c
|
|
c------------------------------------------------------------------------------
|
|
c
|
|
c open NTUPLE file and book NTUPLE
|
|
c
|
|
ntfile = OUT_DIR//'geant_lemsr_'//runno//'.nt'
|
|
c
|
|
iquest(10) = 65000 ! to allocate enough space for NTUPLE
|
|
call hropen(80,'GEANT',ntfile,'NQ',4096,istat)
|
|
if (istat.eq.0) then
|
|
write(6,*) '%GEANT-LEMSR-I- succesfully opened NTUPLE file '
|
|
write(6,*) ' '
|
|
write(6,*) ntfile
|
|
else
|
|
write(6,'('' %GEANT-LEMSR-E- error opening NTUPLE file '',/,a)')
|
|
1 ntfile
|
|
call exit
|
|
endif
|
|
c
|
|
c book CWN
|
|
c
|
|
call hbnt(111,'GEANT_LEMSR', 'D') ! 'D' disk resident NTUPLE
|
|
c
|
|
c now define the variable blocks for CWN
|
|
c
|
|
if ( l_init_par .or. l_allv ) then
|
|
call hbname(111,'init_par', nt_x0,
|
|
1 'x0:r*4, y0:r*4, z0:r*4,'//
|
|
2 'px0:r*4, py0:r*4, pz0:r*4, p0:r*4')
|
|
endif
|
|
c
|
|
if ( l_code .or. l_allv ) then
|
|
call hbname(111,'partcode', nt_ipart, 'Ipart:u*4:9')
|
|
endif
|
|
if ( l_endp .or. l_allv ) then
|
|
call hbname(111,'endpos' , nt_xe,
|
|
1 'xe:r*4, ye:r*4, ze:r*4, epos:r*4')
|
|
endif
|
|
if ( l_time .or. l_allv ) then
|
|
call hbname(111,'times' , nt_tmcp, 'tmcp:r*4, tsci:r*4')
|
|
endif
|
|
if ( l_scip .or. l_allv ) then
|
|
call hbname(111,'sci_pos' , nt_xsci,
|
|
1 'xsci:r*4, ysci:r*4, zsci:r*4')
|
|
endif
|
|
if ( l_scie .or. l_allv ) then
|
|
call hbname(111,'sci_elos', nt_desci,
|
|
1 'desci:r*4, descipos:r*4, descigam:r*4, desciele:r*4')
|
|
endif
|
|
c
|
|
if ( l_scop .or. l_allv ) then
|
|
call hbname(111,'sco_pos' , nt_xsco,
|
|
1 'xsco:r*4, ysco:r*4, zsco:r*4')
|
|
endif
|
|
if ( l_scoe .or. l_allv ) then
|
|
call hbname(111,'sco_elos', nt_desco,
|
|
1 'desco:r*4, descopos:r*4, descogam:r*4, descoele:r*4')
|
|
endif
|
|
c
|
|
if ( l_flag .or. l_allv ) then
|
|
call hbname(111,'flags' , nt_volno, 'volno:u*4:8,'//
|
|
1 'partcode:u*4:7')
|
|
endif
|
|
if ( l_nhit .or. l_allv ) then
|
|
call hbname(111,'nhits' , nt_mcpnhits,
|
|
1 'mcpnhits:u*4:8, scinhits:u*4:8, sconhits:u*4:8')
|
|
endif
|
|
if ( l_posm .or. l_allv ) then
|
|
call hbname(111,'pos_mom' , nt_pxpos,
|
|
1 'pxpos:r*4, pypos:r*4, pzpos:r*4')
|
|
endif
|
|
if ( l_mcpe .or. l_allv ) then
|
|
call hbname(111,'de_mcp' , nt_demcp, 'demcp:r*4')
|
|
endif
|
|
c
|
|
if ( l_ltrb .or. l_allv ) then
|
|
call hbname(111,'de_ltrb' , nt_descil, 'de_left_i:r*4,'//
|
|
1 'de_top_i:r*4, de_rite_i:r*4, de_bot_i:r*4,'//
|
|
2 'de_left_o:r*4,'//
|
|
3 'de_top_o:r*4, de_rite_o:r*4, de_bot_o:r*4')
|
|
endif
|
|
c
|
|
if ( lsets(7) .eq. 1 ) then ! read initial data from file
|
|
c
|
|
write(6,*) ' '
|
|
write(6,*) ' lsets(7) = 1 ---> I will read data from file ',
|
|
1 INFILE
|
|
open(70, file=INFILE, form='UNFORMATTED', status='OLD',
|
|
1 err=2000)
|
|
write(6,*) ' '
|
|
write(6,*) '%GEANT_LEMSR-I- Successfully opened file ', INFILE
|
|
read(70) nevent
|
|
write(6,*) ' '
|
|
write(6,*) ' Number of events in file = ', nevent
|
|
write(6,*) ' '
|
|
endif
|
|
c
|
|
c----------------------------------------------------------------- c
|
|
c
|
|
c E N D OF I N I T I A L I S A T I O N
|
|
c c
|
|
c-----------------------------------------------------------------
|
|
c
|
|
c now do the tracking
|
|
c
|
|
call grun
|
|
c
|
|
c update all workstations
|
|
c
|
|
if ( lplot(1) .gt. 0 ) call iuwk(0,1)
|
|
c
|
|
c accept some input to have time to look at the picture
|
|
c
|
|
if ( lplot(1) .gt. 0 ) then
|
|
write(6,*) ' '
|
|
write(6,*) ' type anything to continue '
|
|
read(5,*)
|
|
endif
|
|
if ( lplot(1) .gt. 1 ) then
|
|
call iclwk(5) ! advance paper
|
|
close(10)
|
|
endif
|
|
c
|
|
c end GEANT and HPLOT
|
|
c
|
|
call glast
|
|
c
|
|
if ( lplot(1) .gt. 0 ) call igend
|
|
c
|
|
if ( lsets(7) .eq. 1) then
|
|
close(70)
|
|
write(6,*) ' '
|
|
write(6,*) '%GEANT-LEMSR-I- closed input file ', INFILE
|
|
write(6,*) ' '
|
|
endif
|
|
c
|
|
c write data and close NTUPLE file
|
|
c
|
|
call hrout(111,i,' ')
|
|
call hrend('GEANT')
|
|
close(80)
|
|
write(6,*) '%GEANT-LEMSR-I- closed NTUPLE file ', ntfile
|
|
write(6,*) '%GEANT-LEMSR-I- results of NEUMANN rejection for '//
|
|
1 'MICHEL spectrum : '
|
|
write(6,'(t10,'' rejected trials : '',i10)') rejcou
|
|
write(6,'(t10,'' succes. trials : '',i10)') cou
|
|
write(6,*) ' '
|
|
write(6,'(t5,'' RNDM generator seed at the end : '')')
|
|
write(6,'(t10,'' ix1 = '',i15)') ix1
|
|
write(6,*) ' '
|
|
call exit
|
|
c
|
|
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|
|
c
|
|
c error messages
|
|
c
|
|
1000 continue
|
|
write(6,'(''0%GEANT-LEMSR-E- error reading GDRAW parameter...'')')
|
|
call exit
|
|
c
|
|
1001 continue
|
|
write(6,'(''0%GEANT-LEMSR-E- error opening '',a)') psfile
|
|
call exit
|
|
c
|
|
1002 continue
|
|
write(6,'(''0%GEANT-LEMSR-E- error write RunNo to string...'')')
|
|
write(6,*) ' may be, you entered a run number with more than '
|
|
write(6,*) ' 4 digits...'
|
|
call exit
|
|
c
|
|
1003 continue
|
|
write(6,'(''0%GEANT-LEMSR-E- error opening input file '',a)')
|
|
1 PARFILE
|
|
call exit
|
|
c
|
|
2000 continue
|
|
write(6,*) '%GEANT-LEMSR-E- error opening input file ', INFILE
|
|
call exit
|
|
end
|