musrsim/geant3/src/lemsr/gustep.F

162 lines
4.8 KiB
Fortran

#include "geant321/pilot.h"
c
c----------------------------------------------------------------------
c
subroutine gustep
c
c T. Prokscha, 15-Sep-2000, PSI
c
c Unix Version, part of the geant_lemsr program
c
c TP, 05-Apr-2001, PSI Unix, NT, Linux
c
c----------------------------------------------------------------------
c
implicit none
c
c include again some GEANT variables
c
#define CERNLIB_TYPE
#include "geant321/gckine.inc"
#include "geant321/gctrak.inc"
#include "geant321/gctmed.inc"
#include "geant321/gcking.inc"
#include "geant321/gcsets.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gclist.inc"
#include "geant321/gcflag.inc"
c
c NTuple variable and other common variables
c
#include "cwn.inc"
#include "common.inc"
c
integer*4 j, part
integer*4 ihit
c
real*4 hits(7)
c
c------------------------------------------------------------------
c
c store secondary particle data to GEANT structure JSTAK
c
do j = 1,ngkine
part = gkin(5,j)
if ( part .eq. 4 ) then ! neutrinos, discard them
iflgk(j) = -1
elseif ( part .eq. 2) then ! save e+ in JKINE and transport
if ( l_pos) then
iflgk(j) = 1
else
iflgk(j) = -1
endif
elseif ( part .eq. 1) then
if ( l_gam ) then
iflgk(j) = 0 ! simply transport the rest
else
iflgk(j) = -1
endif
elseif ( part .eq. 3) then
if ( l_ele ) then
iflgk(j) = 0 ! simply transport the rest
else
iflgk(j) = -1
endif
else ! discard other part. in any
iflgk(j) = -1 ! case
endif
enddo
call gsking(0) ! store secondary particle data to JSTAK
c
c
c print*,' particle type = ',ipart
c print*,' tracking medium number = ',numed
c print*,' isvol = ',isvol
c print*,' current track position = ',vect(1),vect(2),vect(3)
c print*,' current momentum = ',vect(4),vect(5),vect(6)
c print*,' total momentum = ',vect(7)
c print*,' current kinetic energy = ',gekin
c print*,' number of steps for = ',nstep
c print*,' total energy lost = ',destep
c print*,' current TOF = ',tofg
c print*,' istop = ',istop
c print*,' igauto = ',idecad
c print*,' inwvol = ',inwvol
c print*,'---------------------'
c
c
if ( lplot(1) .gt. 0) call gdcxyz
c
c store spatial,momentum and energy loss data to GEANT data structure
c JXYZ
c
c call gsxyz
c call gpcxyz
c
c look where the e+ stops
c
if (ipart.eq.2.and.(inwvol.eq.3.or.istop.ge.1)) then
c
nt_xe = vect(1)
nt_ye = vect(2)
nt_ze = vect(3)
nt_eposend = 1000. * gekin
c
endif
c
c look now for detector hits
c
if ( idtype .eq. 1) then
c
hits(1) = vect(1)
hits(2) = vect(2)
hits(3) = vect(3)
hits(4) = tofg
hits(5) = gekin
hits(6) = destep
hits(7) = float(ipart)
call gsahit(iset,idet,itra,numbv,hits,ihit) ! MCP
if ( lplot(1) .gt. 0 ) then ! draw and plot hit
call gphits('MDET','DMCP')
call gdhits('MDET','DMCP',0,854,.3)
endif
c
endif
c
if ( idtype .eq. 2) then
c
hits(1) = vect(1)
hits(2) = vect(2)
hits(3) = vect(3)
hits(4) = tofg
hits(5) = gekin
hits(6) = destep
hits(7) = float(ipart)
call gsahit(iset,idet,itra,numbv,hits,ihit) ! inner Scint.
if ( lplot(1) .gt. 0 ) then ! plot hit
call gphits('ISSC','SCIS')
call gdhits('ISSC','SCIS',0,852,.3)
endif
c
endif
c
if ( idtype .eq. 3) then
c
hits(1) = vect(1)
hits(2) = vect(2)
hits(3) = vect(3)
hits(4) = tofg
hits(5) = gekin
hits(6) = destep
hits(7) = float(ipart)
call gsahit(iset,idet,itra,numbv,hits,ihit) ! outer Scint.
c
if ( lplot(1) .gt. 0 ) then ! plot hit
call gphits('OSSC','SCOS')
call gdhits('OSSC','SCOS',0,842,.3)
endif
c
endif
return
end