sane_geant_mc/SRC/guout.f - annotate

Return to guout.f CVS log

Up to [HallC] / sane_geant_mc / SRC

1 jones 1.1 SUBROUTINE GUOUT 2 3 implicit none 4 5 include 'beta_geom.inc' 6 include 'sane_misc.inc' 7 include 'geant.inc' 8 include 'sane_cwn.inc' 9 include 'sane.inc' 10 11 integer changes 12 integer i,j
13 jones 1.2 integer iclust
14 jones 1.1 15 integer4 cl,last_cl 16 real4 eng,d1,d2 17 integer ihhit 18 REAL*4 X_HOD(28),Y_HOD(28),Z_HOD(28), 19 , T_HOD(28),E_HOD(28) 20 common/TEMPR/ihhit,X_HOD,Y_HOD,Z_HOD,T_HOD,E_HOD
21 jones 1.2 c real Eyx(5,5),xx(5,5),yy(5,5)
22 jones 1.1 real Eyx(5,5),xx(5,5),yy(5,5) 23 common/ENERGYYX/Eyx,xx,yy 24 25 integer nnclust,nnclustA 26 real Emax,Etot,Etot9 27 real xmax,ymax,xmom,ymom 28 integer ixmax,iymax 29 real Etot3pp,Etot3pm,Etot3mp,Etot3mm 30 common/gg/nnclustA,nnclust,Etot,Etot9, 31 , ixmax,iymax,Emax,xmax,ymax, 32 , Etot3pp,Etot3pm,Etot3mp,Etot3mm 33 34 double precision FixX,FixY,FixE 35 common/SNEU/FixX,FixY,FixE 36 37 real X_coor,Y_coor,E_coor,Z_coor 38 real X_coor_r,Y_coor_r,E_coor_r,Z_coor_r 39 40 real V_coor(3),V_coor_r(3) 41 real PHI_C,THETA_C 42 real PHI_UC,THETA_UC 43 jones 1.1 44 real Emt 45 real xmomsqr,xmomsq,ymomsqr,ymomsq 46 c double precision VectorN(12) 47 double precision VectorN(27) 48 double precision COORE,coorX2,coorY2 49 character80 arg 50 double precision sane_n100xye 51 52 real8 Cspead 53 parameter (Cspead = 29.9792458) 54 parameter (Z_coor=335) 55 C 56 C Fill the total energy of the event in the histogram 57 C 58 59 c write(,)'num_gc=',num_gc 60 cwn_p_ne =0 61 cwn_p_ng =0 62 cwn_p_np =0 63 do i=1,num_gc 64 jones 1.1 c write(,)i,gc_part(i) 65 if (gc_part(i).eq.1) then 66 c write(,)gc_x(i),gc_y(i),gc_eng(i) 67 cwn_p_ng = cwn_p_ng + 1 68 cwn_p_gx(cwn_p_ng) = gc_x(i) 69 cwn_p_gy(cwn_p_ng) = gc_y(i) 70 cwn_p_ge(cwn_p_ng) = gc_eng(i) 71 elseif (gc_part(i).eq.2) then 72 c write(,)gc_x(i),gc_y(i),gc_eng(i) 73 cwn_p_np = cwn_p_np + 1 74 cwn_p_px(cwn_p_np) = gc_x(i) 75 cwn_p_py(cwn_p_np) = gc_y(i) 76 cwn_p_pe(cwn_p_np) = gc_eng(i) 77 elseif (gc_part(i).eq.3) then 78 c write(,)gc_x(i),gc_y(i),gc_eng(i),cwn_p_ne 79 cwn_p_ne = cwn_p_ne + 1 80 cwn_p_ex(cwn_p_ne) = gc_x(i) 81 cwn_p_ey(cwn_p_ne) = gc_y(i) 82 cwn_p_ee(cwn_p_ne) = gc_eng(i) 83 endif 84 enddo 85 jones 1.1 c if(part.gt.20.or.part.le.0)then 86 c write(,) 'Events: ',numevts,'GenEvent',part 87 call getarg(2,arg) 88 read(arg,'(i1)') particle 89 part=particle 90 c write(,)EE,pp,part,tgt_num,tgt_num1 91 if(tgt_num.ne.tgt_num1.and.tgt_num.gt.200)tgt_num=tgt_num1 92 if(abs(tgt_num).gt.200)goto 1101 93 c part = iipart 94 c write(,)particle 95 c endif 96 97 c write(,)'part=',part 98 cwn_E = EE 99 cwn_p = pp 100 cwn_part = part 101 c write(,)z(tgt_num),n(tgt_num) 102 cwn_z = z(tgt_num) 103 cwn_n = n(tgt_num) 104 cwn_xsn = xsn 105 c write(,)'CR in NTUPLE ',xsn 106 jones 1.1 cwn_asym = asym 107 cwn_th = th 108 cwn_ph = ph 109 cwn_cerphot = photCer 110 111 call NANcheckF(xsn,12) 112 call NANcheckF(asym,13) 113 114 C write(,)0,th180/3.141,ph-90 115 cwn_cergood = photGood 116 117 C --- Front and Lucite Hososcopes -JDM - 6/20/07 118 call digi_tracker() 119 call digi_lucite() 120
121 jones 1.2 CCC Loop over clusters to include other particles HB,NK 04/28/10 122 nclust=0 123 do iclust=1,5 124 call digi_cal() 125 etot=0 126 do i=1,5 127 do j=1,5 128 etot=etot+eyx(i,j) 129 enddo
130 jones 1.1 enddo
131 jones 1.2 132 c write(,)2,part,eyx(3,3) 133 if(Eyx(3,3).gt.0.and.etot.gt.0.15)then 134 nclust=nclust+1 135 VectorN(1) = eyx(1,1) 136 VectorN(2) = eyx(2,1) 137 VectorN(3) = eyx(3,1) 138 VectorN(4) = eyx(4,1) 139 VectorN(5) = eyx(5,1) 140 VectorN(6) = eyx(1,2) 141 VectorN(7) = eyx(2,2) 142 VectorN(8) = eyx(3,2) 143 VectorN(9) = eyx(4,2) 144 VectorN(10) = eyx(5,2) 145 VectorN(11) = eyx(1,3) 146 VectorN(12) = eyx(2,3) 147 VectorN(13) = eyx(3,3) 148 VectorN(14) = eyx(4,3) 149 VectorN(15) = eyx(5,3) 150 VectorN(16) = eyx(1,4) 151 VectorN(17) = eyx(2,4) 152 jones 1.2 VectorN(18) = eyx(3,4) 153 VectorN(19) = eyx(4,4) 154 VectorN(20) = eyx(5,4) 155 VectorN(21) = eyx(1,5) 156 VectorN(22) = eyx(2,5) 157 VectorN(23) = eyx(3,5) 158 VectorN(24) = eyx(4,5) 159 VectorN(25) = eyx(5,5) 160 161 VectorN(26) = DBLE(ixmax) 162 VectorN(27) =DBLE(iymax) 163
164 jones 1.1 165 166 COORX2 = sane_n100xye(VectorN,0) 167 COORY2 = sane_n100xye(VectorN,1) 168 COORE = sane_n100xye(VectorN,2)
169 jones 1.2 X_coor= XX(3,3)+COORX2 170 Y_coor= YY(3,3)+COORY2 171 E_coor= etot+CoorE 172 V_coor(1) = X_coor 173 V_coor(2) = Y_coor 174 V_coor(3) = Z_coor 175 call ROTATE(V_coor,0.,-403.1415926536/180.,0.,V_coor_r) 176 c write(,*)1,V_coor,YY(3,3)
177 jones 1.1 c write(,)2,V_coor_r,CoorE
178 jones 1.2 X_coor_r = V_coor_r(1) 179 Y_coor_r = V_coor_r(2) 180 Z_coor_r = V_coor_r(3) 181 182 call NANcheckF(E_coor,1) 183 call NANcheckF(x_coor,2) 184 call NANcheckF(y_coor,3) 185 call NANcheckF(Z_coor,4) 186 call NANcheckF(X_coor_r,5) 187 call NANcheckF(Y_coor_r,6) 188 call NANcheckF(Z_coor_r,7) 189 cwn_x_ur(iclust)=X_coor 190 cwn_y_ur(iclust)=Y_coor 191 cwn_z_ur(iclust)=Z_coor 192 call digi_cer(iclust) 193
194 jones 1.1 c write(,) X_coor_r, 195 c , Y_coor_r, 196 c , Z_coor_r, 197 c , E_coor*1000
198 jones 1.2 call CORRECT_ANGLES( 199 , X_coor_r, 200 , Y_coor_r, 201 , Z_coor_r, 202 , E_coor*1000,
203 jones 1.1 , THETA_C ,
204 jones 1.2 , PHI_C,cer_h(iclust)) 205 206 cwn_E_r(iclust)=E_coor 207 cwn_th_r(iclust)=THETA_C 208 cwn_ph_r(iclust)=PHI_C 209 cwn_x_r(iclust)=X_coor_r 210 cwn_y_r(iclust)=Y_coor_r 211 cwn_z_r(iclust)=Z_coor_r 212 call NANcheckF(THETA_C,8) 213 call NANcheckF(PHI_C,9) 214
215 jones 1.1
216 jones 1.2 call UNCORRECT_ANGLES( 217 , X_coor_r, 218 , Y_coor_r, 219 , Z_coor_r, 220 , E_coor*1000, 221 , THETA_UC , 222 , PHI_UC) 223 224 c enddo !! Finish looping over clusters 225 226 call NANcheckF(THETA_UC,10) 227 call NANcheckF(PHI_UC,11) 228 cwn_th_ucr(iclust)=THETA_UC 229 cwn_ph_ucr(iclust)=PHI_UC 230 231 do i=1,5 232 do j=1,5 233 Eyx(i,j)=0 234 XX(i,j)=0 235 YY(i,j)=0 236 enddo
237 jones 1.1 enddo
238 jones 1.2 239 endif 240 enddo !! Finish looping over clusters 241
242 jones 1.1 c write(,)etot,coore,EE,etot+coorE,etot+FixE 243 244 C ---- JDM 245 246 if (photGood.gt.0) then 247 * write(,) '# cerenkov photons:',photCer,photGood 248 if (idebug.ne.0) call gdxyz(0) 249 endif 250 251 * write(,) part,cwn_part 252 253 do i=1,6 254 cwn_u(i) = uu(i) 255 cwn_dedl(i) = ELoss(i) 256 enddo 257 258 cwn_nb = 0 259 do i=1,vert_blocks 260 do j=1,horz_blocks 261 if (dEBloc(i,j).gt.0.001 .or. photBloc(i,j).gt.0) then 262 cwn_nb = cwn_nb + 1 263 jones 1.1 cwn_bx(cwn_nb) = i 264 cwn_by(cwn_nb) = j 265 cwn_bg(cwn_nb) = photBloc(i,j) 266 cwn_be(cwn_nb) = dEBloc(i,j) 267 endif 268 enddo 269 enddo
270 jones 1.2 c if (.not.(Eloss(4).eq.0.and.Eloss(1).eq.0.and. 271 c 1 cwn_nb.eq.0.and.photCer.eq.0))then 272 if(nclust.gt.0)then 273 c write(,)nclust 274 c write(,) '# cerenkov photons:',photCer,photGood 275 call hfnt(nt_geant)
276 jones 1.1 endif
277 jones 1.2 call clear_cer() 278 call clear_cal() 279 c endif
280 jones 1.1 281 c write(,)'Next step' 282 cccc 283 cc 284 c NEW NEURAL NETWORK PART 285 cc 286 287 288 c write(,)EYX 289 c write(,) VectorN(1),Emax 290 291 * if (num_electrons+num_positrons.ge.2) write(,) electron_radius 292 * if (num_gc.gt.0) then 293 * do i=1,num_gc 294 * write(,) gc_part(i),gc_x(i),gc_y(i),gc_eng(i) 295 * enddo 296 * write(,) 'gammas (n,r,<x>,<y>,eng)',num_gammas,gamma_radius, 297 * 1 gamma_ave_x,gamma_ave_y,gamma_eng 298 * write(,) 'electrons (n,r,<x>,<y>,eng)',num_electrons, 299 * 1 electron_radius,electron_ave_x,electron_ave_y,electron_eng 300 * cg* write(,) 'positrons (n)',num_positrons 301 jones 1.1 * endif 302 303 C 304 1101 CONTINUE 305 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))
306 jones 1.2 c enddo
307 jones 1.1 END 308 cccccccccccccccccccccccccccc 309 ccc 310 ccc 311 ccc 312 ccc 313 c$$$ subroutine NeuralParam(Emax,Emt,Etot9,Etot, 314 c$$$ , xmomsqr,xmom,xmomsq,ymomsqr,ymom,ymomsq,ixmax,iymax,Eyx, 315 c$$$ , XX,YY) 316 c$$$ IMPLICIT NONE 317 c$$$c include 'bigcal_data_structures.cmn' 318 c$$$c include 'sane_data_structures.cmn' 319 c$$$c include 'b_ntuple.cmn' 320 c$$$c include 'sane_ntuple.cmn' 321 c$$$c include 'gen_data_structures.cmn' 322 c$$$c include 'gen_event_info.cmn' 323 c$$$ 324 c$$$ real xmomsqr,xmom,xmomsq,ymomsqr,ymom,ymomsq 325 c$$$ integer jmax 326 c$$$ real emax 327 c$$$ 328 jones 1.1 c$$$c real norma1(32,10),norma2(32,10),norma3(32,10),norma4(32,10), 329 c$$$c , norma5(32,10),norma6(32,6),norm(56,32) 330 c$$$c common/NOR1/norma1,norma2,norma3,norma4,norma5,norma6,norm 331 c$$$ real eyx(5,5),XX(5,5),YY(5,5),en,Emt,Etot9,Etot 332 c$$$ integer ixmax, iymax,jj,i,ii 333 c$$$ real Xmomf 334 c$$$ 335 c$$$ 336 c$$$ emax=eyx(3,3) 337 c$$$c write(,)"EMAX+ ",eyx(3,3) 338 c$$$ etot =0 339 c$$$ 340 c$$$ etot9 =eyx(2,2)+eyx(2,3)+eyx(2,4)+ 341 c$$$ , eyx(3,2)+eyx(3,3)+eyx(3,4)+ 342 c$$$ , eyx(4,2)+eyx(4,3)+eyx(4,4) 343 c$$$ etot =eyx(1,1)+eyx(1,2)+eyx(1,3)+eyx(1,4)+eyx(1,5)+ 344 c$$$ , eyx(2,1)+eyx(2,2)+eyx(2,3)+eyx(2,4)+eyx(2,5)+ 345 c$$$ , eyx(3,1)+eyx(3,2)+eyx(3,3)+eyx(3,4)+eyx(3,5)+ 346 c$$$ , eyx(4,1)+eyx(4,2)+eyx(4,3)+eyx(4,4)+eyx(4,5)+ 347 c$$$ , eyx(5,1)+eyx(5,2)+eyx(5,3)+eyx(5,4)+eyx(5,5) 348 c$$$ 349 jones 1.1 c$$$ Emt = emax/Etot 350 c$$$ 351 c$$$ xmomsqr = XMomf(ixmax,iymax,eyx,xx,2); 352 c$$$ xmom = XMomf(ixmax,iymax,eyx,xx,1); 353 c$$$ xmomsq = XMomf(ixmax,iymax,eyx,xx,3); 354 c$$$ ymomsqr = XMomf(ixmax,iymax,eyx,yy,2); 355 c$$$ ymom = XMomf(ixmax,iymax,eyx,yy,1); 356 c$$$ ymomsq = XMomf(ixmax,iymax,eyx,yy,3); 357 c$$$c write(,)xmomsqr,xmom,xmomsq,ymomsqr,ymom,ymomsq 358 c$$$ 359 c$$$ end 360 c$$$ 361 c$$$ real function XMomf(ix,iy,eyx,x,iflag) 362 c$$$ IMPLICIT NONE 363 c$$$c include 'bigcal_data_structures.cmn' 364 c$$$c include 'sane_data_structures.cmn' 365 c$$$c include 'b_ntuple.cmn' 366 c$$$c include 'sane_ntuple.cmn' 367 c$$$c include 'gen_data_structures.cmn' 368 c$$$ real eyx(5,5),x(5,5) 369 c$$$ 370 jones 1.1 c$$$ real w(5,5),Sum,SumW,Coor 371 c$$$ 372 c$$$ Integer i,j,icx,icy,ix,iy,iflag 373 c$$$ Sum=0 374 c$$$ do i=1,5 375 c$$$ do j=1,5 376 c$$$ icx = ix+(j-3) 377 c$$$ icy = iy+(i-3) 378 c$$$ if(icx.gt.0.and.icy.gt.0.and. 379 c$$$ , icy.lt.57.and.eyx(i,j).lt.5)then 380 c$$$ if(iflag.eq.1.and.eyx(i,j).lt.5)Sum = Sum+eyx(i,j) 381 c$$$ if(iflag.eq.2.and.eyx(i,j).lt.5)Sum = Sum+sqrt(eyx(i,j)) 382 c$$$ if(iflag.eq.3.and.eyx(i,j).lt.5)Sum = Sum+eyx(i,j)eyx(i,j) 383 c$$$ icx = ix+(j-3) 384 c$$$ icy = iy+(i-3) 385 c$$$ w(i,j) = x(i,j)-x(3,3) 386 c$$$ 387 c$$$ endif 388 c$$$ enddo 389 c$$$ enddo 390 c$$$ 391 jones 1.1 c$$$ Coor=0 392 c$$$ 393 c$$$ do i=1,5 394 c$$$ do j=1,5 395 c$$$ if(iflag.eq.1)Coor =Coor+w(i,j)eyx(i,j)/Sum 396 c$$$ if(iflag.eq.2)Coor =Coor+w(i,j)sqrt(eyx(i,j))/Sum 397 c$$$ if(iflag.eq.3)Coor =Coor+w(i,j)eyx(i,j)*eyx(i,j)/Sum 398 c$$$ enddo 399 c$$$ enddo 400 c$$$ 401 c$$$ XMomf=Coor 402 c$$$ 403 c$$$ end 404 c$$$ 405 c$$$ include 'neurale.f' 406 c$$$ include 'sane_neurale.f' 407 c$$$ include 'sane_neuralx.f' 408 c$$$ include 'sane_neuraly.f' 409 include 'sane_n100xye.f' 410 cccccccccccccccccccccccccccccccccccccccccccccccccccc
411 jones 1.2 Subroutine CORRECT_ANGLES(x,y,z,ee,th,phi,cer_stat)
412 jones 1.1 IMPLICIT NONE 413 c 414 c X = X(Bigcal)-X(raster) 415 c Y = Y(Bigcal)-Y(raster) 416 c Z = Z(Bigcal) 417 c EE - energy in GEV 418 c RETURNS THeta and PHI In Degree. 419 c 420 cccccccccccc 421 c include 'sane_data_structures.cmn' 422 c include 'gen_run_info.cmn' 423 include 'sane.inc' 424 include 'pmc.inc' 425 real x,y,z 426 real th,phi,thr,phr,ee 427 real dist,SANE_BETA_OMEGA
428 jones 1.2 real*8 P_th(10),P_phi(10) 429 430 integer cer_stat 431 data P_th / 432 , -2.199987805718, 1.312318933346, 0.644032653274, 433 , 2.001711272282 , 4.831055345667, 434 , 0.596870277140 , 0.237530064696 , -0.444891749961, 435 , -0.668604044519 , -1.988327254812/ 436 data P_Phi / 437 , -1.206886920591, 3.898203794202, 1.409952555564 , 438 , -0.737821993549, 4.693839032660, 439 , -0.853486677346, -3.282568717839 , 1.891695882259, 440 , 1.158605334109 , -4.578605424909/
441 jones 1.1 442 dist = sqrt(x2+y2+z*2) 443 thr = acos(z/dist) 444 phr = atan2(y/dist,x/dist) 445 c write(,)1,thr180/3.141,phr*180/3.141,y 446 447 448 c$$$ SANE_BETA_OMEGA = abs(theta_0 - abs(Theta_Bfield)) !! 1st attempt w/ ANN 449 c SANE_BETA_OMEGA = 40!abs(theta_0 - abs(Theta_Bfield)) 450 c SANE_BETA_OMEGA = abs(theta_0 - Theta_Bfield)
451 jones 1.2 SANE_BETA_OMEGA = omega !! Use definition from uginit.f
452 jones 1.1 c print,X,Y,Z,DIST,thr,phr 453 c print,SANE_BETA_OMEGA
454 jones 1.2 if(cer_stat.gt.0)then 455
456 jones 1.1 if(field_type.gt.0)then 457 if(SANE_BETA_OMEGA.lt.50)then
458 jones 1.2 call POLYNOM_CORRECTION(SANE_TRANSFORM_MATRIX_THETA_40, 459 , SANE_TRANSFORM_MATRIX_PHI_40,thr, 460 , phr,ee,th,phi, 461 , SANE_BETA_OMEGA) 462 elseif (SANE_BETA_OMEGA.gt.130)then 463 call POLYNOM_CORRECTION(SANE_TRANSFORM_MATRIX_THETA_140, 464 , SANE_TRANSFORM_MATRIX_PHI_140,thr, 465 , phr,ee,th,phi, 466 , SANE_BETA_OMEGA) 467 else 468 WRITE(,)'WARNING : YOU DON T' 469 WRITE(,)'HAVE SANE_TRANSFORM_MATRIX CONSTANTS' 470 471 endif 472 473 else 474 phi=phr180/3.14159 475 th = thr180/3.14159 476 endif
477 jones 1.1 else
478 jones 1.2 c phi=phr180/3.14159 479 c th = thr180/3.14159 480 th = THR180/3.1415926+ 481 , (P_th(1)+P_th(2)phr+P_th(3)thr+ 482 , P_th(4)phr*2+P_th(5)thr*2)/EE+ 483 , (P_th(6)+P_th(7)thr+P_th(8)phr+ 484 , P_th(9)phr*2+P_th(10)thr2)/EE2 485 phi = phR180/3.1415926 486 , +(P_phi(1)+P_phi(2)phr+P_phi(3)phr2+ 487 , P_phi(4)phr*3+P_phi(5)thr+P_phi(6)thr2+ 488 , P_phi(7)thr*3+P_phi(8)phrthr+ 489 , P_phi(9)phr*2thr+ 490 , P_phi(10)phrthr**2) 491
492 jones 1.1 endif 493 494 phi=phi 495 c write(,)phr180/3.141-90,phi,SANE_BETA_OMEGA 496 497 c write(,)thr180/3.1415926,th,phr180/3.1415926 498 c print,thr(180.d0/3.1415926),phr(180.d0/3.1415926),th,phi 499 c , ,SANE_BETA_OMEGA 500 501 end 502 ccccccccccccccccccccccccccccccccccccccccccccccccccccc 503 Subroutine POLYNOM_CORRECTION(P_th,P_phi,thr,phr,eMev,th,phi, 504 , omega_beta) 505 IMPLICIT NONE 506 507 c 508 c Input patameters are P(26) -transformation Matrix 509 c input thr and phr angles from CALORIMETER ,THr and PHr in radians 510 c EE Energy in GEV 511 c Output :TH and Phi Correctes in degrees 512 cc 513 jones 1.1 ccccccc 514 c include 'sane.inc' 515 c include 'pmc.inc' 516 real th,phi,thr,phr,eMev,ee 517 real omega_beta 518 real P_th(14),P_phi(38),cosom,sinom 519 ee=eMeV/1000. 520 cosom = cos(omega_beta3.1415926/180.d0) 521 sinom = sin(omega_beta3.1415926/180.d0) 522 c write(,)ee 523 524 th = thr180/3.1415926+ 525 , ((P_th(1)+P_th(2)phr+P_th(3)thr+P_th(4)phr*2 526 , +P_th(5)thr*2)/ee) 527 , (P_th(6)cosom+P_th(7)sinom)+ 528 , ((P_th(8)+P_th(9)thr+P_th(10)phr+ 529 , P_th(11)phr2+P_th(12)thr2)/ee2)* 530 , (P_th(13)cosom+P_th(14)sinom) 531 532 533 534 jones 1.1 phi = phr180/3.1415926 535 , +(P_phi(1)cosom+P_phi(2)phrcosom+P_phi(3)phr2cosom+ 536 , P_phi(4)phr3cosom+P_phi(5)thrcosom+ 537 , P_phi(6)thr2cosom+ 538 , P_phi(7)thr3cosom+P_phi(8)phrthrcosom+ 539 , P_phi(9)phr*2thrcosom+ 540 , P_phi(10)phrthr2cosom)+ 541 , ( P_phi(11)cosom+P_phi(12)phrcosom+ 542 , P_phi(13)phr*2cosom+ 543 , P_phi(14)thrcosom+P_phi(15)thr2cosom+ 544 , P_phi(16)phrthrcosom)/ee 545 , +(P_phi(17)sinom+P_phi(18)phrsinom+ 546 , P_phi(19)phr2sinom+ 547 , P_phi(20)phr3sinom+P_phi(21)thrsinom+ 548 , P_phi(22)thr2sinom+ 549 , P_phi(23)thr3sinom+P_phi(24)phrthrsinom+ 550 , P_phi(25)phr*2thrsinom+ 551 , P_phi(26)phrthr2sinom)+ 552 , ( P_phi(27)sinom+P_phi(28)phrsinom+ 553 , P_phi(29)phr*2sinom+ 554 , P_phi(30)thrsinom+P_phi(31)thr2sinom+ 555 jones 1.1 , P_phi(32)phrthrsinom)/ee+ 556 , P_phi(33)sinom*2+P_phi(34)sinom*3+P_phi(35)sinom*4 557 , +P_phi(36)sinom*5+P_phi(37)sinom*6+P_phi(38)sinom*7 558 c write(,)phi,phr180/3.14159 559 560 c write(,)'corrected',th,phi 561 end 562 563 564 cccccccccccccccccccccccccccccccccccccccccccccccccccc 565 ccc Uncorrected angles, for comparison 566 567 Subroutine UNCORRECT_ANGLES(x,y,z,ee,thu,phiu) 568 IMPLICIT NONE 569 c 570 c X = X(Bigcal)-X(raster) 571 c Y = Y(Bigcal)-Y(raster) 572 c Z = Z(Bigcal) 573 c EE - energy in GEV 574 c RETURNS THeta and PHI In Degree. 575 c 576 jones 1.1 cccccccccccc 577 c include 'sane_data_structures.cmn' 578 c include 'gen_run_info.cmn' 579 include 'sane.inc' 580 include 'pmc.inc' 581 real x,y,z 582 real thu,phiu,thr,phr,ee 583 real dist 584 585 dist = sqrt(x2+y2+z*2) 586 thr = acos(z/dist) 587 phr = atan2(y/dist,x/dist) 588 c write(,)1,thr180/3.141,phr180/3.141,y 589 590 thu = thr(180/3.141592) 591 phiu = phr(180/3.141592) 592 593 c write(,)'uncorrected',thu,phiu 594 595 end 596 597 jones 1.1 cccccccccccc 598 cccccccccccc 599 subroutine NANcheckF(l,did) 600 IMPLICIT NONE 601 real4 l 602 integer did 603 if(l.ne.l)then 604 l=0 605 write(,)'CHECK NAN ',did 606 endif 607 end
608 jones 1.2 609 c subroutine Blockzero 610 c$$$ do i=1,32 611 c$$$ do j=1,56 612 c$$$ Energy(i,j)=0 613 c$$$ enddo 614 c$$$ enddo

Analyzer/Replay: Mark Jones, Documents: Stephen Wood