geant_gep/src/gustep.f - annotate

Return to gustep.f CVS log

Up to [HallC] / geant_gep / src

1 jones 1.1 subroutine gustep 2 c 3 c this subroutine was written by jpsullivan april 21-22, 1993 4 c the tracking realated part is relatively simple -- if the 5 c particle leave the volume called 'targ', throw it away. 6 c it also makes a bunch of histograms 7 c 8 c keep,gctrak. 9 -- author : 10 common/gctrak/vect(7),getot,gekin,vout(7),nmec,lmec(30),namec(30) 11 + ,nstep ,maxnst,destep,destel,safety,sleng 12 + ,step ,snext ,sfield 13 + ,tofg ,gekrat,upwght,ignext,inwvol,istop ,idecad,iekbin 14 + , ilosl, imull,ingoto,nldown,nlevin,nlvsav,istory 15 c 16 integer nmec,lmec,namec,nstep ,maxnst,ignext,inwvol,istop 17 + ,idecad,iekbin,ilosl, imull,ingoto,nldown,nlevin 18 + ,nlvsav,istory 19 real vect,getot,gekin,vout,destep,destel,safety,sleng ,step 20 + ,snext,sfield,tofg ,gekrat,upwght 21 c end gctrak 22 jones 1.1 * keep,gcvolu. 23 -- author : 24 common/gcvolu/nlevel,names(15),number(15), 25 + lvolum(15),lindex(15),infrom,nlevmx,nldev(15),linmx(15), 26 + gtran(3,15),grmat(10,15),gonly(15),glx(3) 27 c 28 integer nlevel,number,lvolum,lindex,infrom,nlevmx, 29 + nldev,linmx 30 character4 names 31 real gtran,grmat,gonly,glx 32 c end gcvolu 33 c 34 * keep,gcbank. 35 -- author : 36 integer iq,lq,nzebra,ixstor,ixdiv,ixcons,lmain,lr1 37 integer kwbank,kwwork,iws 38 real gversn,zversn,fendq,ws,q 39 c 40 parameter (kwbank=69000,kwwork=5200) 41 common/gcbank/nzebra,gversn,zversn,ixstor,ixdiv,ixcons,fendq(16) 42 + ,lmain,lr1,ws(kwbank) 43 jones 1.1 dimension iq(2),q(2),lq(8000),iws(2) 44 equivalence (q(1),iq(1),lq(9)),(lq(1),lmain),(iws(1),ws(1)) 45 common/gclink/jdigi ,jdraw ,jhead ,jhits ,jkine ,jmate ,jpart 46 + ,jrotm ,jrung ,jset ,jstak ,jgstat,jtmed ,jtrack,jvertx 47 + ,jvolum,jxyz ,jgpar ,jgpar2,jsklt 48 c 49 integer jdigi ,jdraw ,jhead ,jhits ,jkine ,jmate ,jpart 50 + ,jrotm ,jrung ,jset ,jstak ,jgstat,jtmed ,jtrack,jvertx 51 + ,jvolum,jxyz ,jgpar,jgpar2 ,jsklt 52 c 53 keep,gcking. 54 -- author : 55 common/gcking/kcase,ngkine,gkin(5,100),tofd(100),iflgk(100) 56 integer kcase,ngkine ,iflgk 57 real gkin,tofd 58 c end gcking 59 c 60 keep,gckine. 61 -- author : 62 -- author : 63 integer ikine,itra,istak,ivert,ipart,itrtyp,napart,ipaold 64 jones 1.1 real pkine,amass,charge,tlife,vert,pvert 65 common/gckine/ikine,pkine(10),itra,istak,ivert,ipart,itrtyp 66 + ,napart(5),amass,charge,tlife,vert(3),pvert(4),ipaold 67 c end gckine 68 c 69 integer ihset,ihdet,iset,idet,idtype,nvname,numbv 70 common/gcsets/ihset,ihdet,iset,idet,idtype,nvname,numbv(20) 71 real x1,y1,z1,lpar,v1,v2,v3,newdist,x1new,y1new,z1new 72 real xstr,ystr,zstr,xstrnew,ystrnew,zstrnew 73 real rotmat2,rotmat3,rotmat4,rotmat1 74 c 75 common/geomstep/rotmat1(3,3),rotmat2(3,3),rotmat3(3,3), 76 & rotmat4(3,3) 77 c 78 include 'fpp_local.h' 79 include 'geant_local.h' 80 c include 'parameter.h' 81 c include 'espace_type.h' 82 c include 'detector.h' 83 c include 'transport.h' 84 c include 'option.h' 85 jones 1.1 c 86 c 87 integer i,make_hist,ioff,ihit,ieffcheck 88 real pt_pi,ppar_pi,arg1,arg2,rapid_pi,pchmb,hits(6) 89 real a,b,c,beta,z,y,straw,ypath,rndm(3),ycompare
90 brash 1.2 c write(6,)'entering gustep' 91 c write(6,)'inwvol =',inwvol 92 c write(6,)'position =',vect(1),vect(2),vect(3) 93 c write(6,)'names =',names(nlevel)
94 jones 1.1 c 95 c 96 c 97 if ( ngkine.gt.0. ) then 98 do i=1,nmec 99 if ( lmec(i).eq.12 ) then 100 c write ( 6,* ) ' gustep: hadronic interaction' 101 c write ( 6,* ) ' nevent=',nevent 102 end if 103 end do 104 mylast = min(100,ngkine) 105 do i=1,mylast 106 iflgk(i) = 1 107 if ( gkin(5,i).eq.4 ) iflgk(i) = 0 108 if ( gkin(4,i).gt.0.001 ) iflgk(i)=0 109 end do 110 c n_2nd = n_2nd + ngkine 111 endif 112 c 113 c the following call makes sure all of the secondary particles 114 c get tracked too (provided the flag iflgk(i) for that particle 115 jones 1.1 c was set in the loop above -- this point is not correctly or 116 c clearly documented in the version of the geant manual i have). 117 c 118 c if(sectrack) then 119 c call gsking ( 0 ) 120 c endif 121 c 122 make_hist = 0 123 if ( inwvol.eq.1 .and. names(nlevel).eq."hall" ) then 124 make_hist=1 125 c 126 c if we get here, the tracking is done for this track 127 c (istop=1) but make a bunch of histograms before exitting 128 c note that ipart=8 means a pi+ and 9 is a pi- 129 c 130 c istop = 1 131 else if ( istop.ne.0.and. names(nlevel).eq."aira" ) then 132 make_hist=0 133 else if ( istop.ne.0.and. names(nlevel).eq."airb" ) then 134 make_hist=0 135 else if ( istop.ne.0.and. names(nlevel).eq."airc" ) then 136 jones 1.1 make_hist=0 137 else if ( istop.ne.0.and. names(nlevel).eq."aird" ) then 138 make_hist=0
139 brash 1.2 else if ( istop.ne.0.and. names(nlevel).eq."aire" ) then 140 make_hist=0 141 else if ( istop.ne.0.and. names(nlevel).eq."airf" ) then 142 make_hist=0 143 else if ( istop.ne.0.and. names(nlevel).eq."airg" ) then 144 make_hist=0 145 else if ( istop.ne.0.and. names(nlevel).eq."airh" ) then 146 make_hist=0 147 else if ( istop.ne.0.and. names(nlevel).eq."hch1" ) then 148 make_hist=0 149 else if ( istop.ne.0.and. names(nlevel).eq."hch2" ) then 150 make_hist=0
151 brash 1.4 else if ( names(nlevel).eq."fch1" ) then 152 if(inwvol.eq.1) then 153 write(6,)'Coordinates at fch1' 154 write(6,)'x=',vect(1),' y=',vect(2),' z=',vect(3) 155 xpfch1=vect(1) 156 ypfch1=vect(2) 157 zpfch1=vect(3) 158 endif 159 if ( istop.ne.0 ) then 160 make_hist=0 161 endif
162 brash 1.2 else if ( istop.ne.0.and. names(nlevel).eq."fch2" ) then 163 make_hist=0 164 else if ( istop.ne.0.and. names(nlevel).eq."fch3" ) then 165 make_hist=0 166 else if ( istop.ne.0.and. names(nlevel).eq."fch4" ) then 167 make_hist=0 168 else if ( istop.ne.0.and. names(nlevel).eq."sci1" ) then 169 make_hist=0 170 else if ( names(nlevel).eq."anl1" ) then
171 jones 1.1 if(inwvol.eq.1) then
172 brash 1.4 write(6,)'We have a hit in the fist analyzer at' 173 write(6,)'x=',vect(1),' y=',vect(2),' z=',vect(3) 174 xdet=vect(1) 175 ydet=vect(2) 176 zdet=vect(3)
177 jones 1.1 endif 178 if ( istop.ne.0 ) then 179 make_hist=0 180 endif 181 end if 182 c 183 c 184 c store current track parameters (including position ) in jxyz structure. 185 c 186 call gsxyz 187 c 188 c moved histograming stuff to gulast 189 c 190 c write(6,*)'done in gustep' 191 9999 return 192 end 193

Analyzer/Replay: Mark Jones, Documents: Stephen Wood