subroutine gustep c c this subroutine was written by jpsullivan april 21-22, 1993 c the tracking realated part is relatively simple -- if the c particle leave the volume called 'targ', throw it away. c it also makes a bunch of histograms c c *keep,gctrak. *-- author : common/gctrak/vect(7),getot,gekin,vout(7),nmec,lmec(30),namec(30) + ,nstep ,maxnst,destep,destel,safety,sleng + ,step ,snext ,sfield + ,tofg ,gekrat,upwght,ignext,inwvol,istop ,idecad,iekbin + , ilosl, imull,ingoto,nldown,nlevin,nlvsav,istory c integer nmec,lmec,namec,nstep ,maxnst,ignext,inwvol,istop + ,idecad,iekbin,ilosl, imull,ingoto,nldown,nlevin + ,nlvsav,istory real vect,getot,gekin,vout,destep,destel,safety,sleng ,step + ,snext,sfield,tofg ,gekrat,upwght c end gctrak * keep,gcvolu. *-- author : common/gcvolu/nlevel,names(15),number(15), + lvolum(15),lindex(15),infrom,nlevmx,nldev(15),linmx(15), + gtran(3,15),grmat(10,15),gonly(15),glx(3) c integer nlevel,number,lvolum,lindex,infrom,nlevmx, + nldev,linmx character*4 names real gtran,grmat,gonly,glx c end gcvolu c * keep,gcbank. *-- author : integer iq,lq,nzebra,ixstor,ixdiv,ixcons,lmain,lr1 integer kwbank,kwwork,iws real gversn,zversn,fendq,ws,q c parameter (kwbank=69000,kwwork=5200) common/gcbank/nzebra,gversn,zversn,ixstor,ixdiv,ixcons,fendq(16) + ,lmain,lr1,ws(kwbank) dimension iq(2),q(2),lq(8000),iws(2) equivalence (q(1),iq(1),lq(9)),(lq(1),lmain),(iws(1),ws(1)) common/gclink/jdigi ,jdraw ,jhead ,jhits ,jkine ,jmate ,jpart + ,jrotm ,jrung ,jset ,jstak ,jgstat,jtmed ,jtrack,jvertx + ,jvolum,jxyz ,jgpar ,jgpar2,jsklt c integer jdigi ,jdraw ,jhead ,jhits ,jkine ,jmate ,jpart + ,jrotm ,jrung ,jset ,jstak ,jgstat,jtmed ,jtrack,jvertx + ,jvolum,jxyz ,jgpar,jgpar2 ,jsklt c * keep,gcking. *-- author : common/gcking/kcase,ngkine,gkin(5,100),tofd(100),iflgk(100) integer kcase,ngkine ,iflgk real gkin,tofd c end gcking c * keep,gckine. *-- author : *-- author : integer ikine,itra,istak,ivert,ipart,itrtyp,napart,ipaold real pkine,amass,charge,tlife,vert,pvert common/gckine/ikine,pkine(10),itra,istak,ivert,ipart,itrtyp + ,napart(5),amass,charge,tlife,vert(3),pvert(4),ipaold c end gckine c integer ihset,ihdet,iset,idet,idtype,nvname,numbv common/gcsets/ihset,ihdet,iset,idet,idtype,nvname,numbv(20) real x1,y1,z1,lpar,v1,v2,v3,newdist,x1new,y1new,z1new real xstr,ystr,zstr,xstrnew,ystrnew,zstrnew real rotmat2,rotmat3,rotmat4,rotmat1 c common/geomstep/rotmat1(3,3),rotmat2(3,3),rotmat3(3,3), & rotmat4(3,3) c include 'fpp_local.h' include 'geant_local.h' c include 'parameter.h' c include 'espace_type.h' c include 'detector.h' c include 'transport.h' c include 'option.h' c c integer i,make_hist,ioff,ihit,ieffcheck real pt_pi,ppar_pi,arg1,arg2,rapid_pi,pchmb,hits(6) real a,b,c,beta,z,y,straw,ypath,rndm(3),ycompare c write(6,*)'entering gustep' c write(6,*)'inwvol =',inwvol c write(6,*)'position =',vect(1),vect(2),vect(3) c write(6,*)'names =',names(nlevel) c c c if ( ngkine.gt.0. ) then do i=1,nmec if ( lmec(i).eq.12 ) then c write ( 6,* ) ' gustep: hadronic interaction' c write ( 6,* ) ' nevent=',nevent end if end do mylast = min(100,ngkine) do i=1,mylast iflgk(i) = 1 if ( gkin(5,i).eq.4 ) iflgk(i) = 0 if ( gkin(4,i).gt.0.001 ) iflgk(i)=0 end do c n_2nd = n_2nd + ngkine endif c c the following call makes sure all of the secondary particles c get tracked too (provided the flag iflgk(i) for that particle c was set in the loop above -- this point is not correctly or c clearly documented in the version of the geant manual i have). c c if(sectrack) then c call gsking ( 0 ) c endif c make_hist = 0 if ( inwvol.eq.1 .and. names(nlevel).eq."hall" ) then make_hist=1 c c if we get here, the tracking is done for this track c (istop=1) but make a bunch of histograms before exitting c note that ipart=8 means a pi+ and 9 is a pi- c c istop = 1 else if ( istop.ne.0.and. names(nlevel).eq."aira" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."airb" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."airc" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."aird" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."aire" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."airf" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."airg" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."airh" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."hch1" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."hch2" ) then make_hist=0 else if ( names(nlevel).eq."fch1" ) then if(inwvol.eq.1) then write(6,*)'Coordinates at fch1' write(6,*)'x=',vect(1),' y=',vect(2),' z=',vect(3) xpfch1=vect(1) ypfch1=vect(2) zpfch1=vect(3) endif if ( istop.ne.0 ) then make_hist=0 endif else if ( istop.ne.0.and. names(nlevel).eq."fch2" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."fch3" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."fch4" ) then make_hist=0 else if ( istop.ne.0.and. names(nlevel).eq."sci1" ) then make_hist=0 else if ( names(nlevel).eq."anl1" ) then if(inwvol.eq.1) then write(6,*)'We have a hit in the fist analyzer at' write(6,*)'x=',vect(1),' y=',vect(2),' z=',vect(3) xdet=vect(1) ydet=vect(2) zdet=vect(3) endif if ( istop.ne.0 ) then make_hist=0 endif end if c c c store current track parameters (including position ) in jxyz structure. c call gsxyz c c moved histograming stuff to gulast c c write(6,*)'done in gustep' 9999 return end