sane_geant_mc/SRC/guout.f - diff

Return to guout.f CVS log

Up to [HallC] / sane_geant_mc / SRC

Diff for /sane_geant_mc/SRC/guout.f between version 1.1 and 1.3

version 1.1, 2010/04/22 14:13:54

version 1.3, 2011/07/01 14:52:45

Line 10

integer changes

integer i,j

integer iclust

integer*4 cl,last_cl

real*4 eng,d1,d2

Line 17

Line 18

REAL*4 X_HOD(28),Y_HOD(28),Z_HOD(28),

, T_HOD(28),E_HOD(28)

common/TEMPR/ihhit,X_HOD,Y_HOD,Z_HOD,T_HOD,E_HOD

c real Eyx(5,5),xx(5,5),yy(5,5)

real Eyx(5,5),xx(5,5),yy(5,5)

common/ENERGYYX/Eyx,xx,yy

Line 50

Line 52

real*8 Cspead

parameter (Cspead = 29.9792458)

parameter (Z_coor=335)

real q2,xb,wsq,nu

C Fill the total energy of the event in the histogram

Line 115

Line 119

C --- Front and Lucite Hososcopes -JDM - 6/20/07

call digi_tracker()

call digi_lucite()

CCC Loop over clusters to include other particles HB,NK 04/28/10

nclust=0

do iclust=1,5

call digi_cal()

etot=0

do i=1,5

do j=1,5

etot=etot+eyx(i,j)

enddo

c write(*,*)2,part,eyx(3,3)

if(eyx(3,3).gt.0)then

if(Eyx(3,3).gt.0.and.etot.gt.0.15)then

c write(*,*)eyx

nclust=nclust+1

c call NeuralParam(Emax,Emt,Etot9,Etot,

c , xmomsqr,xmom,xmomsq,ymomsqr,ymom,ymomsq,

c , ixmax,iymax,EYX,XX,YY)

c$$$ VectorN(1) = Emax

c$$$ VectorN(2) = emax/Etot

c$$$ VectorN(3) = Etot9

c$$$ VectorN(4) = Etot

c$$$ VectorN(5) = xmomsqr

c$$$ VectorN(6) = xmom

c$$$ VectorN(7) = xmomsq

c$$$ VectorN(8) = ymomsqr

c$$$ VectorN(9) = ymom

c$$$ VectorN(10) =ymomsq

c$$$ VectorN(11) = DBLE(ixmax)

c$$$ VectorN(12) =DBLE(iymax)

c$$$

c$$$ call neuralx(VectorN,0)

c$$$ call neuraly(VectorN,0)

c$$$ call neurale(VectorN,0)

c$$$

c$$$ COORX2 = FixX

c$$$ COORY2 = FixY

c$$$ COORE = FixE

c call nneurale(VectorN,0)

VectorN(1) = eyx(1,1)

VectorN(2) = eyx(2,1)

VectorN(3) = eyx(3,1)

Line 175

Line 163

VectorN(26) = DBLE(ixmax)

VectorN(27) =DBLE(iymax)

c call neuralx(VectorN,0)

c call neuraly(VectorN,0)

c call neurale(VectorN,0)

etot=0

do i=1,5

do j=1,5

etot=etot+eyx(i,j)

enddo

COORX2 = sane_n100xye(VectorN,0)

COORY2 = sane_n100xye(VectorN,1)

COORE = sane_n100xye(VectorN,2)

X_coor= XX(3,3)+COORX2

Line 209

Line 189

call NANcheckF(X_coor_r,5)

call NANcheckF(Y_coor_r,6)

call NANcheckF(Z_coor_r,7)

cwn_x_ur(iclust)=X_coor

cwn_y_ur(iclust)=Y_coor

cwn_z_ur(iclust)=Z_coor

call digi_cer(iclust)

c if(X_coor_r.gt.253.5.and.Y_coor_r.gt.12)then

c write(*,*) X_coor_r

c , ,Y_coor_r

c , ,Z_coor_r

c , ,E_coor*1000

c endif

CCC Smear to get resolution similar to data HB NK 08/11/10

CCCC 12% shift seems to get it closest from pi0 mass peak.

E_coor = E_coor +(rand()-0.5)*2*0.12*E_coor

c E_coor = E_coor +(rand()-0.5)*2*0.09*E_coor

c write(*,*) X_coor_r,

c , Y_coor_r,

c , Z_coor_r,

c , E_coor*1000

call CORRECT_ANGLES(

, X_coor_r,

, Y_coor_r,

, Z_coor_r,

, E_coor*1000,

, THETA_C ,

, PHI_C)

, PHI_C,cer_h(iclust),srx,sry)

cwn_E_r(iclust)=E_coor

cwn_th_r(iclust)=THETA_C

cwn_ph_r(iclust)=PHI_C

cwn_x_r(iclust)=X_coor_r

cwn_y_r(iclust)=Y_coor_r

cwn_z_r(iclust)=Z_coor_r

cwn_E_r=E_coor

cwn_th_r=THETA_C

cwn_ph_r=PHI_C

cwn_x_r=X_coor_r

cwn_y_r=Y_coor_r

cwn_z_r=Z_coor_r

cwn_x_ur=X_coor

cwn_y_ur=Y_coor

cwn_z_ur=Z_coor

call NANcheckF(THETA_C,8)

call NANcheckF(PHI_C,9)

nu = E_beam/1000.d0 - E_coor

q2 = 2.d0*E_beam/1000.d0*E_coor*(1-cos(THETA_C/180.d0*3.14159d0))

xb = q2/2.d0/0.938d0/nu

wsq = 0.938d0**2 + 2.d0*0.938d0*nu - q2

cwn_Q2_r(iclust)=q2

cwn_xb_r(iclust)=xb

cwn_W_r(iclust)=sqrt(wsq)

c if(X_coor_r.gt.253.5)then

C if(X_coor_r.gt.253.5.and.PHI_C.gt.10)then

c if(X_coor_r.gt.253.5.and.THETA_C.gt.40)then

c write(*,*) X_coor_r

c , ,Y_coor_r

c , ,THETA_C

c , ,PHI_C

c endif

call UNCORRECT_ANGLES(

, X_coor_r,

Line 243

Line 251

, THETA_UC ,

, PHI_UC)

c enddo !! Finish looping over clusters

call NANcheckF(THETA_UC,10)

call NANcheckF(PHI_UC,11)

cwn_th_ucr=THETA_UC

cwn_th_ucr(iclust)=THETA_UC

cwn_ph_ucr=PHI_UC

cwn_ph_ucr(iclust)=PHI_UC

do i=1,5

do j=1,5

Line 255

Line 265

YY(i,j)=0

enddo

endif

enddo !! Finish looping over clusters

c write(*,*)etot,coore,EE,etot+coorE,etot+FixE

C ---- JDM

Line 283

Line 297

endif

enddo

if (.not.(Eloss(4).eq.0.and.Eloss(1).eq.0.and.

c if (.not.(Eloss(4).eq.0.and.Eloss(1).eq.0.and.

1 cwn_nb.eq.0.and.photCer.eq.0))then

c 1 cwn_nb.eq.0.and.photCer.eq.0))then

if(abs(EE).gt.0)call hfnt(nt_geant)

if(nclust.gt.0)then

endif

c write(*,*)nclust

c write(*,*) '# cerenkov photons:',photCer,photGood

write(56,*)zz_t,nn_t,0.938**2+

, 2*0.938*(E_beam-E_coor)-

, 2*E_beam*E_coor*(1-cos(THETA_C/180.*3.141)),

, xsn,E_coor,THETA_C,-EE,th*180/3.14159

call hfnt(nt_geant)

endif

call clear_cer()

call clear_cal()

c endif

c write(*,*)'Next step'

cccc

Line 315

Line 337

1101 CONTINUE

111 format(2(1x,f6.3),3(1x,i2),1x,e13.5,8(f9.3,1x),5(f9.6,1x),3(i2,1x),2(f7.3,1x,f7.3,1x,f7.4,1x,f7.4,1x))

c enddo

END

cccccccccccccccccccccccccccc

ccc

Line 419

Line 442

c$$$ include 'sane_neuraly.f'

include 'sane_n100xye.f'

cccccccccccccccccccccccccccccccccccccccccccccccccccc

Subroutine CORRECT_ANGLES(x,y,z,ee,th,phi)

Subroutine CORRECT_ANGLES(x,y,z,ee,th,phi,cer_stat,srx,sry)

IMPLICIT NONE

c X = X(Bigcal)-X(raster)

Line 436

Line 459

real x,y,z

real th,phi,thr,phr,ee

real dist,SANE_BETA_OMEGA

real*8 P_th(10),P_phi(10)

real srx,sry

integer cer_stat

data P_th /

, -2.199987805718, 1.312318933346, 0.644032653274,

, 2.001711272282 , 4.831055345667,

, 0.596870277140 , 0.237530064696 , -0.444891749961,

, -0.668604044519 , -1.988327254812/

data P_Phi /

, -1.206886920591, 3.898203794202, 1.409952555564 ,

, -0.737821993549, 4.693839032660,

, -0.853486677346, -3.282568717839 , 1.891695882259,

, 1.158605334109 , -4.578605424909/

dist = sqrt(x**2+y**2+z**2)

thr = acos(z/dist)

Line 446

Line 483

c$$$ SANE_BETA_OMEGA = abs(theta_0 - abs(Theta_Bfield)) !! 1st attempt w/ ANN

c SANE_BETA_OMEGA = 40!abs(theta_0 - abs(Theta_Bfield))

c SANE_BETA_OMEGA = abs(theta_0 - Theta_Bfield)

SANE_BETA_OMEGA = omega !! Use same

SANE_BETA_OMEGA = omega !! Use definition from uginit.f

c print*,X,Y,Z,DIST,thr,phr

c print*,SANE_BETA_OMEGA

if(cer_stat.gt.0)then

c write(*,*)field_type

c write(*,*)SANE_BETA_OMEGA

if(field_type.gt.0)then

if(SANE_BETA_OMEGA.lt.50)then

c write(*,*)SANE_BETA_OMEGA

if(SANE_BETA_OMEGA.gt.-50)then

call POLYNOM_CORRECTION(SANE_TRANSFORM_MATRIX_THETA_40,

, SANE_TRANSFORM_MATRIX_PHI_40,thr,

, phr,ee,th,phi,

, SANE_BETA_OMEGA)

, srx,sry)

elseif (SANE_BETA_OMEGA.gt.130)then

elseif (SANE_BETA_OMEGA.lt.-130)then

call POLYNOM_CORRECTION(SANE_TRANSFORM_MATRIX_THETA_140,

, SANE_TRANSFORM_MATRIX_PHI_140,thr,

, phr,ee,th,phi,

, SANE_BETA_OMEGA)

, srx,sry)

else

WRITE(*,*)'WARNING : YOU DON T'

WRITE(*,*)'HAVE SANE_TRANSFORM_MATRIX CONSTANTS'

endif

c write(*,*)phi,phr*180/3.141

else

phi=phr*180/3.14159

th = thr*180/3.14159

endif

else

c phi=phr*180/3.14159

c th = thr*180/3.14159

th = THR*180/3.1415926+

, (P_th(1)+P_th(2)*phr+P_th(3)*thr+

, P_th(4)*phr**2+P_th(5)*thr**2)/EE+

, (P_th(6)+P_th(7)*thr+P_th(8)*phr+

, P_th(9)*phr**2+P_th(10)*thr**2)/EE**2

phi = phR*180/3.1415926

, +(P_phi(1)+P_phi(2)*phr+P_phi(3)*phr**2+

, P_phi(4)*phr**3+P_phi(5)*thr+P_phi(6)*thr**2+

, P_phi(7)*thr**3+P_phi(8)*phr*thr+

, P_phi(9)*phr**2*thr+

, P_phi(10)*phr*thr**2)

endif

phi=phi

c write(*,*)phr*180/3.141-90,phi,SANE_BETA_OMEGA

Line 480

Line 540

end

ccccccccccccccccccccccccccccccccccccccccccccccccccccc

Subroutine POLYNOM_CORRECTION(P_th,P_phi,thr,phr,eMev,th,phi,

, omega_beta)

, srx,sry)

IMPLICIT NONE

Line 494

Line 554

c include 'pmc.inc'

real th,phi,thr,phr,eMev,ee

real omega_beta

real P_th(14),P_phi(38),cosom,sinom

real P_th(15),P_phi(15),cosom,sinom,srx,sry

ee=eMeV/1000.

cosom = cos(omega_beta*3.1415926/180.d0)

c cosom = cos(omega_beta*3.1415926/180.d0)

sinom = sin(omega_beta*3.1415926/180.d0)

c sinom = sin(omega_beta*3.1415926/180.d0)

c write(*,*)ee

th = thr*180/3.1415926+

, ((P_th(1)+P_th(2)*phr+P_th(3)*thr+P_th(4)*phr**2

, (p_th(1)+p_th(2)*thr+p_th(3)*phr+p_th(4)*thr**2+

, +P_th(5)*thr**2)/ee)*

, p_th(5)*phr**2+p_th(6)*thr*phr)*

, (P_th(6)*cosom+P_th(7)*sinom)+

, (p_th(7)+p_th(8)/EE+p_th(9)/EE**2)*

, ((P_th(8)+P_th(9)*thr+P_th(10)*phr+

, (p_th(10)+p_th(11)*srx+p_th(12)*srx**2)*

, P_th(11)*phr**2+P_th(12)*thr**2)/ee**2)*

, (p_th(13)+p_th(14)*sry+p_th(15)*sry**2)

, (P_th(13)*cosom+P_th(14)*sinom)

phi = phr*180/3.1415926

, +(P_phi(1)*cosom+P_phi(2)*phr*cosom+P_phi(3)*phr**2*cosom+

, P_phi(4)*phr**3*cosom+P_phi(5)*thr*cosom+

, P_phi(6)*thr**2*cosom+

, P_phi(7)*thr**3*cosom+P_phi(8)*phr*thr*cosom+

, P_phi(9)*phr**2*thr*cosom+

, P_phi(10)*phr*thr**2*cosom)+

, ( P_phi(11)*cosom+P_phi(12)*phr*cosom+

, P_phi(13)*phr**2*cosom+

, P_phi(14)*thr*cosom+P_phi(15)*thr**2*cosom+

, P_phi(16)*phr*thr*cosom)/ee

, +(P_phi(17)*sinom+P_phi(18)*phr*sinom+

, P_phi(19)*phr**2*sinom+

, P_phi(20)*phr**3*sinom+P_phi(21)*thr*sinom+

, P_phi(22)*thr**2*sinom+

, P_phi(23)*thr**3*sinom+P_phi(24)*phr*thr*sinom+

, P_phi(25)*phr**2*thr*sinom+

, P_phi(26)*phr*thr**2*sinom)+

, ( P_phi(27)*sinom+P_phi(28)*phr*sinom+

, P_phi(29)*phr**2*sinom+

, P_phi(30)*thr*sinom+P_phi(31)*thr**2*sinom+

, P_phi(32)*phr*thr*sinom)/ee+

, P_phi(33)*sinom**2+P_phi(34)*sinom**3+P_phi(35)*sinom**4

, +P_phi(36)*sinom**5+P_phi(37)*sinom**6+P_phi(38)*sinom**7

c write(*,*)phi,phr*180/3.14159

c write(*,*)'corrected',th,phi

phi = phr*180/3.1415926+

, (p_phi(1)+p_phi(2)*thr+p_phi(3)*phr+p_phi(4)*thr**2+

, p_phi(5)*phr**2+p_phi(6)*thr*phr)*

, (p_phi(7)+p_phi(8)/EE+p_phi(9)/EE**2)*

, (p_phi(10)+p_phi(11)*srx+p_phi(12)*srx**2)*

, (p_phi(13)+p_phi(14)*sry+p_phi(15)*sry**2)

end

Line 584

Line 623

write(*,*)'CHECK NAN ',did

endif

end

c subroutine Blockzero

c$$$ do i=1,32

c$$$ do j=1,56

c$$$ Energy(i,j)=0

c$$$ enddo

Legend:

Removed from v.1.1
changed lines
	Added in v.1.3

Analyzer/Replay: Mark Jones, Documents: Stephen Wood