#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