1 c-----------------------------------------------------------------------
2 subroutine jpsifo(npjpsi)
3 c-----------------------------------------------------------------------
5 c-----------------------------------------------------------------------
8 common/geom/rmproj,rmtarg,bmax,bkmx
10 parameter (ndep=129,ndet=129)
11 common/cdep/xdep(ndep),qdep(ndep),wdep(ndep)
12 common/cdet/xdet(ndet),qdet(ndet),wdet(ndet)
14 common /cptj/xptj(nptj),qptj(nptj),wptj(nptj)
16 common/jpsi1/bimmax,kolran,delt,taumi,jpsinu,jpsidr,taudmx
20 parameter (ntjpsi=150)
21 common/jpsi7/xydens(ntjpsi,mxbim,nxmdk,nxmdk),a4min,a4max
22 common/jpsi8/xys(mxbim,nxmdk,nxmdk),a5min,a5max
23 common/jpsi9/ami(ntjpsi,mxmass),a6min,a6max
25 call utpri('jpsifo',ish,ishini,4)
26 if(ish.ge.6)write(ifch,'(a)')' jpsi formation'
39 2 rqptj=rangen()*qptj(nptj)
40 pt=utinvt(nptj,xptj,qptj,rqptj)
46 if(lo.gt.10)call utstop('jpsifo: lo > 10 &')
47 z=0.19*sqrt(-2*alog(rangen()))*cos(2*pi*rangen()) !1-dim gauss
52 e=sqrt(s+px**2+py**2+pz**2)
53 amt=sqrt(amass**2+pt**2)
54 y=sign(1.,pz)*alog( (e+abs(pz))/amt )
55 if(y.lt.ymin.or.y.gt.ymax)goto 2
63 if(npjpsi.gt.mxptl)then
65 call utstop('jpsifo: npjpsi>mxptl&')
74 kolran=1+rangen()*kolevt
75 xorptl(1,npjpsi)=coord(1,kolran)
76 xorptl(2,npjpsi)=coord(2,kolran)
77 xorptl(3,npjpsi)=coord(3,kolran)
78 xorptl(4,npjpsi)=coord(4,kolran)
81 tivptl(1,npjpsi)=xorptl(4,npjpsi)
82 tivptl(2,npjpsi)=ainfin
86 call alist("&",npjpsi,npjpsi)
87 write (ifch,*) xorptl(1,npjpsi)
88 $ ,xorptl(2,npjpsi),xorptl(3,npjpsi),xorptl(4,npjpsi)
89 $ ,tivptl(1,npjpsi),tivptl(2,npjpsi)
91 jj=maproj+itarg(kolran)
92 call alist("collision&",ii,ii)
101 call utprix('jpsifo',ish,ishini,4)
105 c-----------------------------------------------------------------------
107 c-----------------------------------------------------------------------
108 c jpsi pt-distribution in 200 gev pp
109 c-----------------------------------------------------------------------
113 sptj=1/a*c**c/utgam1(c)*z**(c-1)*exp(-c*z)
117 c-----------------------------------------------------------------------
118 subroutine jpsian(ifirst)
119 c-----------------------------------------------------------------------
121 c-----------------------------------------------------------------------
123 include 'epos.incems'
124 parameter (mxbim=12,ntjpsi=150,mxtauc=16)
125 common/jpsi1/bimmax,kolran,delt,taumi,jpsinu,jpsidr,taudmx
126 common/jpsi2/jjtot(mxbim),jjnuc(mxbim),jjjtau(mxbim,mxtauc)
127 common/jpsi3/jjjtot(mxbim,ntjpsi),jjjdro(mxbim,ntjpsi)
128 common/jpsi4/nnucl(mxbim,ntjpsi),nclose(mxbim,ntjpsi,3)
129 common/jpsi5/ndrop(mxbim,ntjpsi),jjjnt(mxbim,mxtauc)
130 parameter (mxmass=20,mxassy=20)
131 common/jpsi6/ndrp2(mxbim,ntjpsi,mxmass,mxassy)
132 & ,ndrop3(mxbim,ntjpsi,mxmass,mxassy)
134 common/jpsi7/xydens(ntjpsi,mxbim,nxmdk,nxmdk),a4min,a4max
135 common/jpsi8/xys(mxbim,nxmdk,nxmdk),a5min,a5max
136 common/jpsi9/ami(ntjpsi,mxmass),a6min,a6max
137 common/jpsi10/ndrop0(mxbim,ntjpsi)
139 double precision tpro,zpro,ttar,ztar,ttaus,detap,detat
140 common/cttaus/tpro,zpro,ttar,ztar,ttaus,detap,detat /ctain/mtain
141 common/geom/rmproj,rmtarg,bmax,bkmx
142 common/nucl3/phi,bimp
143 parameter (ndep=129,ndet=129)
144 common/cdep/xdep(ndep),qdep(ndep),wdep(ndep)
145 common/cdet/xdet(ndet),qdet(ndet),wdet(ndet)
147 common/c9ptl/tauptl(mxptl),ss0ptl(mxptl)
149 call utpri('jpsian',ish,ishini,5)
151 detap=(ypjtl-yhaha)*etafac
161 fac=1 ! <-------- should be one finally
168 bimmax=amin1(rmproj+rmtarg,bmaxim)
171 jj=maproj+itarg(kolran)
174 c.....first event: delete commom blocks...............................
196 xydens(nt,nbim,ix,iy)=0.
206 nbim=1+int(bimevt/delbim)
207 if(nbim.lt.0.or.nbim.gt.mxbim) goto 5
208 jjtot(nbim)=jjtot(nbim)+1 !events pro bin
211 if(idptl(i).eq.441)j=i
214 c if(jpsidr.eq.1)then
215 c write(6,'(a,i5,a,f6.2,a,f6.2,a,f6.2)')'ip=',ip
217 c *,' mass= ',pptl(5,ip)
226 ttaus=ttaus+delt !increment of time
227 if(ish.ge.6)write(ifch,*) 'ttaus:-->',ttaus,ii,jj
229 call jtain(j,xj,yj,zj,tj,n,1)
230 if(n.eq.1.or.n.eq.2.or.n.eq.9)jpsiex=0 !goto 2
231 if(jpsiex.eq.1)jjjtot(nbim,nt)=jjjtot(nbim,nt)+1
236 if(jpsinu.eq.1.and.jpsiex.eq.1)then !test jpsi-nucleon collision
237 do 6 i=1,maproj+matarg
238 if(i.eq.ii.or.i.eq.jj)goto 6
239 nnucl(nbim,nt)=nnucl(nbim,nt)+1
241 x=xorptl(1,i)+(t-xorptl(4,i))*pptl(1,i)/pptl(4,i)
242 y=xorptl(2,i)+(t-xorptl(4,i))*pptl(2,i)/pptl(4,i)
243 z=xorptl(3,i)+(t-xorptl(4,i))*pptl(3,i)/pptl(4,i)
244 pde=(pptl(3,i)+pptl(3,j))/(pptl(4,i)+pptl(4,j))
246 if(gam2i.eq.0.)goto 6
247 dist=sqrt((x-xj)**2+(y-yj)**2
248 & +1/gam2i*(z-zj-(t-tj)*pde)**2)
250 nclose(nbim,nt,1)=nclose(nbim,nt,1)+1
253 write (ifch,*) "nucl dist:",dist,' dist(sig)='
258 elseif(dist.le.rad+1)then
259 nclose(nbim,nt,2)=nclose(nbim,nt,2)+1
260 elseif(dist.le.rad+3)then
261 nclose(nbim,nt,3)=nclose(nbim,nt,3)+1
269 c if ( i.eq.ii.or.i.eq.jj ) goto 8
270 call jtain(i,x,y,z,t,n,1)
272 if(n.eq.1.or.n.eq.2.or.n.eq.9)goto 8
276 c s=(pptl(4,i)+pptl(4,j))**2-(pptl(3,i)+pptl(3,j))**2
277 c $ -(pptl(2,i)+pptl(2,j))**2-(pptl(1,i)+pptl(1,j))**2
278 if ( iad.eq.120 .or. iad.eq.110 ) then !pion
280 elseif ( iad.eq.121 .or. iad.eq.111 ) then ! rho
282 elseif ( iad.eq.1120 .or. iad.eq.1220 ) then
283 sig=3.0 ! ???? or 6 ????
287 call jtaus(zj,tzj,szj) !????????????????? OK ?
288 dist=sqrt((x-xj)**2+(y-yj)**2+(sz-szj)**2)
289 if ( dist .lt. sqrt(0.1*sig/pi) ) then
292 write (ifch,*) "dist:",dist,' dist(sig)='
293 $ ,sqrt(0.1*sig/pi),' sig=',sig
304 call jtaus(zj,tzj,szj)
305 do 3 i=maproj+matarg+1,nptl
306 c...........x-y distribution of strings..............................
307 if(istptl(i).eq.29.and.nt.eq.1)then
308 call jtain(i,x,y,z,t,n,1)
309 if(x.gt.a5min.and.x.lt.a5max.and.
310 & y.gt.a5min.and.y.lt.a5max)then
311 ix=(x-a5min)/(a5max-a5min)*nxmdk + 1
312 iy=(y-a5min)/(a5max-a5min)*nxmdk + 1
313 xys(nbim,ix,iy)=xys(nbim,ix,iy)+pptl(5,i)
316 if(istptl(i).gt.10)goto 3
319 c...................................................................
321 call jtain(i,x,y,z,t,n,1)
322 if(n.eq.1.or.n.eq.2.or.n.eq.9)goto 3
323 stop'jpsian: change!!!! ' !call jintep(i,x,y,z,t,sz,eps,rho)
324 if(eps.lt.aouni)goto 3 !min-dichte
325 ndrop(nbim,nt)=ndrop(nbim,nt)+1 !droplets at time nt
326 ndrop0(nbim,nt)=ndrop0(nbim,nt)+pptl(5,i) !mass
327 des=0 !?????????????????????????????????
330 r=( xxxx(i) +sngl(ttaus) ) *fac
331 c..............assym-mass-distribution...............................
338 if(assym.ge.a1min.and.assym.lt.a1max
339 & .and.amass.ge.a2min.and.amass.lt.a2max
341 nassym=(assym-a1min)/(a1max-a1min)*mxassy+1
342 namass=(amass-a2min)/(a2max-a2min)*mxmass+1
343 ndrp2(nbim,nt,namass,nassym)=
344 & ndrp2(nbim,nt,namass,nassym)+1
347 c..............vol-mass-distribution...............................
350 v=log(pi*r**2.*2.*des)/log(10.)
351 if(v.ge.a3min.and.v.lt.a3max
352 & .and.amass.ge.a2min.and.amass.lt.a2max
354 nv=(v-a3min)/(a3max-a3min)*mxassy+1
355 namass=(amass-a2min)/(a2max-a2min)*mxmass+1
356 ndrop3(nbim,nt,namass,nv)=
357 & ndrop3(nbim,nt,namass,nv)+1
359 c..............x-y distribution of droplet..............................
360 ix=(x-a4min)/(a4max-a4min)*nxmdk + 1
361 iy=(y-a4min)/(a4max-a4min)*nxmdk + 1
362 xydens(nt,nbim,ix,iy)=xydens(nt,nbim,ix,iy)+eps
364 if(jpsiex.eq.0)goto 3
366 c if(mod(nt,10).eq.1)
367 c write(6,'(f5.2,i6,5x,3f7.2,5x,4f6.2)')sngl(ttaus),i,
368 c * u,szj,o,sqrt((x-xj)**2+(y-yj)**2),r,v,eps
370 if(szj.lt.u.or.szj.gt.o)goto 3
371 if((x-xj)**2+(y-yj)**2.gt.r**2)goto 3
373 c write(6,'(a,f5.2,a,i5,a)')'***** t=',sngl(ttaus)
374 c *,' -- jpsi in droplet ',i,' *****'
377 taumax=max(taud,taumax)
379 c write (*,*) taud,taumax
382 jjjdro(nbim,nt)=jjjdro(nbim,nt)+1
385 c if (idrin.ne.1)taud=max(taud-delt,0.)
387 if (idrin.ne.1)taud=0.
390 2 continue !end nt-loop
393 if(ijmod.eq.2)taud=taumax
394 if(nucia.eq.1)jjnuc(nbim)=jjnuc(nbim)+1
397 tauc=ntaud*taudmx/mxtauc
398 if(taud.gt.tauc)jjjtau(nbim,ntaud)=jjjtau(nbim,ntaud)+1
399 if(nucia.eq.1.or.taud.gt.tauc)
400 & jjjnt(nbim,ntaud)=jjjnt(nbim,ntaud)+1
405 & jjjnt(nbim,ntaud)=jjjnt(nbim,ntaud)+1
410 call utprix('jpsian',ish,ishini,5)
414 c-----------------------------------------------------------------------
415 subroutine jtauan(is,im)
416 c-----------------------------------------------------------------------
419 c k > 0 --> post-script
421 c j = 1 --> time and z in n-n cms
422 c j = 2 --> time and z on hyberbola
423 c i > 0 --> text ( changes in alist per time step )
424 c cut in zeta-x (or y) plane for tau
425 c-----------------------------------------------------------------------
427 double precision tpro,zpro,ttar,ztar,ttaus,detap,detat
428 common/cttaus/tpro,zpro,ttar,ztar,ttaus,detap,detat /ctain/mtain
429 parameter (mxbim=12,ntjpsi=150,mxtauc=16)
430 common/jpsi1/bimmax,kolran,delt,taumi,jpsinu,jpsidr,taudmx
431 common/jpsi2/jjtot(mxbim),jjnuc(mxbim),jjjtau(mxbim,mxtauc)
432 common/jpsi3/jjjtot(mxbim,ntjpsi),jjjdro(mxbim,ntjpsi)
433 common/jpsi4/nnucl(mxbim,ntjpsi),nclose(mxbim,ntjpsi,3)
434 common/jpsi5/ndrop(mxbim,ntjpsi),jjjnt(mxbim,mxtauc)
435 parameter (mxmass=20,mxassy=20)
436 common/jpsi6/ndrp2(mxbim,ntjpsi,mxmass,mxassy)
437 & ,ndrop3(mxbim,ntjpsi,mxmass,mxassy)
439 common/jpsi7/xydens(ntjpsi,mxbim,nxmdk,nxmdk),a4min,a4max
440 common/jpsi8/xys(mxbim,nxmdk,nxmdk),a5min,a5max
441 common/jpsi9/ami(ntjpsi,mxmass),a6min,a6max
442 common/jpsi10/ndrop0(mxbim,ntjpsi)
443 character*20 name,nnrr
444 character*28 filename
445 character*12 color(20)
446 character*12 colpo(20)
448 dimension isch(mxptl)
456 c zevent=float(nevent*jpsi)
457 if(mod(im,10).ne.0)then
461 ll=int(log(real(n))/log(10.))+1
464 name(l:l)=char(48+mod(int(n/10**(ii-1)),10))
468 inquire(file=name(1:l),exist=lcalc)
473 write(*,*) 'jtauan name ',name
475 open(unit=ifps,file=name(1:l),status='unknown')
476 WRITE(ifps,'(a)') '%!PS-Adobe-2.0'
477 WRITE(ifps,'(a)') '%%Title: tt2.fig'
478 WRITE(ifps,'(a)') '%%Orientation: Portrait'
479 WRITE(ifps,'(a)') '%%BeginSetup'
480 WRITE(ifps,'(a)') '%%IncludeFeature: *PageSize A4'
481 WRITE(ifps,'(a)') '%%EndSetup'
482 WRITE(ifps,'(a)') '%%EndComments'
483 WRITE(ifps,*) '/l {lineto} bind def'
484 WRITE(ifps,*) '/rl {rlineto} bind def'
485 WRITE(ifps,*) '/m {moveto} bind def'
486 WRITE(ifps,*) '/rm {rmoveto} bind def'
487 WRITE(ifps,*) '/s {stroke} bind def'
488 WRITE(ifps,*) '/gr {grestore} bind def'
489 WRITE(ifps,*) '/gs {gsave} bind def'
490 WRITE(ifps,*) '/cp {closepath} bind def'
491 WRITE(ifps,*) '/tr {translate} bind def'
492 WRITE(ifps,*) '/sc {scale} bind def'
493 WRITE(ifps,*) '/sd {setdash} bind def'
494 WRITE(ifps,*) '/sdo {[.01 .05] 0 sd} bind def'
495 WRITE(ifps,*) '/sdf {[1 .0] 0 sd} bind def'
496 WRITE(ifps,*) '/n {newpath} bind def'
497 WRITE(ifps,*) '/slw {setlinewidth } bind def'
498 write(ifps,*) '/srgb {setrgbcolor} bind def'
499 write(ifps,*) '/lgrey { 0 0.95 0.95 srgb} bind def'
500 write(ifps,*) '/black { 0 0 0 srgb} bind def'
501 write(ifps,*) '/red { 1 0 0 srgb} bind def '
502 write(ifps,*) '/green { 0 1 0 srgb} bind def '
503 write(ifps,*) '/blue { 0 0 1 srgb} bind def '
504 write(ifps,*) '/yellow { 1 0.5 0 srgb} bind def '
505 write(ifps,*) '/turquoise { 0 1 1 srgb} bind def '
506 write(ifps,*) '/purple { 1 0 1 srgb} bind def '
507 c.......write(ifps,*) '/ { srgb} bind def '
508 c.......write(ifps,*) '/ { srgb} bind def '
509 write(ifps,*) '/ef {eofill} bind def'
510 WRITE(ifps,'(a)') '%%EndProlog'
511 WRITE(ifps,*) 'gsave'
512 WRITE(ifps,*) '/Helvetica findfont 10 scalefont setfont'
520 color(5)='turquoise '
529 colpo(8)='Aquamarine '
538 iyb=0 !????????????????????
544 do while (ttaus.lt.20.)
546 ! ttaus=dble(taumin+deltau*(factau**(1.*nt-1.)-1)/(factau-1.))
547 ttaus=taumin+deltau*nt
550 if(mod(im,10).ne.0)then
551 write(ifps,'(a,i4)') '%%Page: number ',np
552 write(ifps,'(a)') 'gsave'
553 WRITE(ifps,*) '100 700 tr'
555 WRITE(ifps,*) 1./scale,1./scale,' sc'
556 WRITE(ifps,*) scale/2.,' slw'
557 WRITE(ifps,*) '/Helvetica findfont ',15.*scale
558 & ,' scalefont setfont'
559 write(ifps,*) color(1),' n ',zmin,xmin,' m ( tau:'
561 WRITE(ifps,*) '/Helvetica findfont ',2.*scale
562 & ,' scalefont setfont'
565 *--------------------------------------------------------------------*
566 *------ povray ------------------------------------------------------*
567 *--------------------------------------------------------------------*
569 if (mod(im/100,10).gt.0) then
570 write (ifch,*) "-----",np,", tau:",ttaus,"------"
572 if (mod(im/10,10).gt.0) then
573 write (nnrr,'(i5)') np
574 li=6-log(1.*np+0.1)/log(10.)
575 write (*,*) "--->"//nnrr(li:5)//"<-----",li,ttaus
577 filename="tau."//nnrr(li:5)//".pov"
578 open(unit=ifpo,file=filename,status='unknown')
579 write (ifpo,'(a)') '#include "colors.inc";'
580 c write (ifpo,'(a)') '#include "shapes.inc" '
581 c write (ifpo,'(a)') '#include "textures.inc" '
582 write (ifpo,'(a)') 'background {color White} '
583 write (ifpo,'(a)') 'camera {location <0,0,-120> '
584 write (ifpo,'(a)') ' direction <0,0,2> look_at <0,0,0>} '
585 write (ifpo,'(a)') 'light_source{<0,300,0> color White} '
586 write (ifpo,'(a)') 'light_source{<0,5,-90> color White} '
587 write (ifpo,'(a)') ' '
588 write (ifpo,'(a)') ' '
591 if (istptl(i).gt.1) goto 123
592 if((tivptl(2,i)-tivptl(1,i)).lt.1e-3
593 $ .and.idptl(i).gt.1000000.and.iyb.eq.0)
595 write (*,*) 'tiv1=tiv2 !!!!!!!!',i
596 tivptl(2,i)=tivptl(1,i)+100.
598 c...........calculate coordinates....................................
599 if(mod(im/10,10).eq.1) then !n-n cms frame
601 $ .or.ttaus.lt.tivptl(1,i)
602 $ .or.ttaus.gt.tivptl(2,i)) goto 123
603 x=xorptl(1,i)+(ttaus-xorptl(4,i))*pptl(1,i)/pptl(4,i)
604 y=xorptl(2,i)+(ttaus-xorptl(4,i))*pptl(2,i)/pptl(4,i)
605 z=xorptl(3,i)+(ttaus-xorptl(4,i))*pptl(3,i)/pptl(4,i)
606 else ! hyperbola frame
607 call jtain(i,x,y,z,t,n,0)
612 c...........plot sphere or cylinder ................................
613 if(idptl(i).gt.700000000)
615 if(mod(im/10,10).eq.1)then
618 des=0 !?????????????????????????????
619 r=0 !(xxxx(i)+vrad*sngl(ttaus))
622 print *,ttaus,o,u,r,x,y
624 if (mod(im/10,10).gt.0) then
625 write (ifpo,111) o,x,y,u,x,y,r,colpo(ic)
628 c.............text output of changes in time step ...................
629 if (mod(im/100,10).gt.0) then
631 write (ifch,'("> ",$)')
638 c$$$ r=(xxxx(i)+vrad*sngl(ttaus))
639 c$$$ rr2=r**2-(y-yb)**2
640 c$$$ if(rr2.gt.0.)then
642 c$$$ & ,' n ',u,x-r,' m ',o,x-r,' l '
643 c$$$ & ,o,x+r,' l ',u,x+r,' l cp s '
644 c$$$ write(ifps,*) ' n ',u,x-r,' m (',i,iorptl(i),') show '
647 c.............cylinder................................................
650 if(abs(idptl(i)).lt.999) r=0.5
651 if(iabs(idptl(i)).eq.1120) ic=2
652 if(iabs(idptl(i)).eq.1220) ic=3
653 if(iabs(idptl(i)).eq.441) ic=5
654 if(mod(im/10,10).gt.0)then
655 write (ifpo,110) z,x,y,r,colpo(ic) ! sphere
657 c.............text...................................................
658 if(mod(im/100,10).gt.0)then
660 write (ifch,'("> ",$)')
668 c.........text................................
669 if(mod(im/100,10).gt.0)then
671 write (ifch,'("< ",$)')
679 110 format('sphere {<',G12.6,',',g12.6,',',g12.6,'>,',g12.6
680 $ ,'pigment {color ',a,'}}')
681 111 format('cylinder {<',
682 $ G12.6,',',g12.6,',',g12.6,
684 $ G12.6,',',g12.6,',',g12.6,
687 $ 'pigment {color ',a,'}}')
688 if(mod(im/10,10).gt.0)then
691 *-------------------------------------------------------------------*
692 *------- end povray ------------------------------------------*
693 *------- begin post-script ---------------------------------------*
694 *-------------------------------------------------------------------*
696 if(mod(im,10).eq.0) goto 159
702 WRITE(ifps,*) 'gsave'
703 WRITE(ifps,*) (xmax-xmin)*1.1*float(int(iyb/4))
704 & ,-(xmax-xmin)*1.1*mod(iyb,4),' tr'
705 write(ifps,*) ' n ',zmin,xmin,' m ',zmax,xmin,' l '
706 & ,zmax,xmax,' l ',zmin,xmax,' l cp s '
708 c.........particles in layer iyb.............
710 if (istptl(i).gt.1) goto 10
711 if((tivptl(2,i)-tivptl(1,i)).lt.1e-3
712 $ .and.idptl(i).gt.1000000.and.iyb.eq.0)
714 write (*,*) 'tiv1=tiv2 !!!!!!!!',i
715 tivptl(2,i)=tivptl(1,i)+100.
717 call jtain(i,x,y,z,t,n,0)
721 $ (is.eq.0.or.is.eq.i.or.is.eq.iorptl(i)))then
723 *............. is is the particle number to observe
724 *............. if is=0 then all particles
726 c .and.abs(y-yb).lt.dy/2)then
727 des=0 !??????????????????????????????????
729 $ .abs(tivptl(2,i)-tivptl(1,i)-100.).le.1e-4 ) then
730 tivptl(2,i)=tivptl(1,i)+0.01
734 r=0 !(xxxx(i)+vrad*sngl(ttaus))
738 c write (*,*) i,des,o,u,r,y
739 write(ifps,*) color(mod(i,5)+2)
740 & ,' n ',u,x-r,' m ',o,x-r,' l '
741 & ,o,x+r,' l ',u,x+r,' l cp s '
742 write(ifps,*) ' n ',u,x-r,' m (',i,iorptl(i),') show '
744 elseif(abs(y-yb).lt.dy/2.and.zmin.lt.sz.and.sz.lt.zmax
745 & .and.xmin.lt.x.and.x.lt.xmax)then
748 if(abs(idptl(i)).lt.999)r=0.5
749 if(abs(idptl(i)).lt.999)ic=2
750 if(abs(idptl(i)).eq.1120)ic=3
751 if(abs(idptl(i)).eq.1220)ic=4
752 if(idptl(i).eq.441) ic=7
755 if(is.eq.0.or.io.eq.is)then
756 write(ifps,*) ' n ',sz,x,r,0,360,' arc ',color(ic),' s '
757 write(ifps,*) ' n ',sz-r,x,' m (',i,io,') show '
761 write(ifps,*) color(1),' n ',zmin,xmin,' m (',yb,') show '
762 WRITE(ifps,*) 'grestore'
764 write(ifps,'(a)') 'grestore'
765 write(ifps,*) 'showpage'
770 c write(ifps,*) ' n ',y0,x0,' m ',y1,x0,' l ',y1,x1,' l '
771 c & ,y0,x1,' l cp s '
772 c write(ifps,*) ' n ',(y0+y1)/2-10.*scale,(x0+x1)/2-5.*scale
773 c & ,' m (',ii,jj,') show '
777 if(mod(im,10).ne.0)then
779 write(ifps,'(a)') '%%Trailer'
780 write(ifps,'(a,i4)') '%%Pages: ',np
781 write(ifps,'(a)') '%%EOF'
788 c-----------------------------------------------------------------------
790 c-----------------------------------------------------------------------
792 c-----------------------------------------------------------------------
794 parameter (mxbim=12,ntjpsi=150,mxtauc=16)
795 common/jpsi1/bimmax,kolran,delt,taumi,jpsinu,jpsidr,taudmx
796 common/jpsi2/jjtot(mxbim),jjnuc(mxbim),jjjtau(mxbim,mxtauc)
797 common/jpsi3/jjjtot(mxbim,ntjpsi),jjjdro(mxbim,ntjpsi)
798 common/jpsi4/nnucl(mxbim,ntjpsi),nclose(mxbim,ntjpsi,3)
799 common/jpsi5/ndrop(mxbim,ntjpsi),jjjnt(mxbim,mxtauc)
800 parameter (mxmass=20,mxassy=20)
801 common/jpsi6/ndrp2(mxbim,ntjpsi,mxmass,mxassy)
802 & ,ndrop3(mxbim,ntjpsi,mxmass,mxassy)
804 common/jpsi7/xydens(ntjpsi,mxbim,nxmdk,nxmdk),a4min,a4max
805 common/jpsi8/xys(mxbim,nxmdk,nxmdk),a5min,a5max
806 common/jpsi9/ami(ntjpsi,mxmass),a6min,a6max
807 common/jpsi10/ndrop0(mxbim,ntjpsi)
809 zevent=float(nevent*jpsi)
811 write(ifhi,'(a)') 'cd /users/theoric/werner/histo/newdata'
812 write(ifhi,'(a)') 'newpage'
814 c suppression as a function of b
815 c ------------------------------
817 write(ifhi,'(a)') 'zone 1 2 1 openhisto'
818 write(ifhi,'(a)') 'htyp lin xmod lin ymod lin'
819 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
820 write(ifhi,'(a)') 'text 0 0 "yaxis J(b) et Jnuc(b) / J"'
821 write(ifhi,'(a,2e11.3)')'xrange',0.,bimmax
822 write(ifhi,'(3a)')'yrange',' 0 ',' auto'
823 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
824 write(ifhi,'(a)') 'array 4'
826 bim=(j-0.5)*bimmax/mxbim
827 write(ifhi,'(4e12.4)')bimmax-bim,jjtot(j)/zevent,0.,zevent
829 write(ifhi,'(a)') ' endarray'
830 write(ifhi,'(a)') 'closehisto plot 0-'
832 write(ifhi,'(a)') 'openhisto'
833 write(ifhi,'(a)') 'htyp lin xmod lin ymod lin'
834 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
835 write(ifhi,'(a)') 'text 0 0 " "'
836 write(ifhi,'(a,2e11.3)')'xrange',0.,bimmax
837 write(ifhi,'(3a)')'yrange',' 0 ',' auto'
838 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
839 write(ifhi,'(a)') 'array 4'
841 bim=(j-0.5)*bimmax/mxbim
842 write(ifhi,'(4e12.4)')bimmax-bim,jjnuc(j)/zevent,0.,zevent
844 write(ifhi,'(a)') ' endarray'
845 write(ifhi,'(a)') 'closehisto plot 0'
848 write(ifhi,'(a)') 'openhisto'
849 write(ifhi,'(a)') 'htyp lin xmod lin ymod lin'
850 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
851 write(ifhi,'(a)') 'text 0 0 "yaxis survival ratio"'
852 write(ifhi,'(a,3e11.3)')'xrange',0.,bimmax
853 write(ifhi,'(3a)')'yrange',' 0.2 ',' auto '
854 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
855 write(ifhi,'(a)') 'array 4'
857 bim=(j-0.5)*bimmax/mxbim
859 if(jjtot(j).gt.0.)rat=float(jjtot(j)-jjnuc(j))/jjtot(j)
860 write(ifhi,'(4e12.4)')bimmax-bim,rat,0.,float(jjtot(j))
862 write(ifhi,'(a)') ' endarray'
863 if(maproj.eq.208.and.matarg.eq.208)then
864 write(ifhi,'(a)') 'closehisto plot 0-'
865 write(ifhi,'(a)') 'openhisto'
866 write(ifhi,'(a)') 'set fmsc 1.0'
867 write(ifhi,'(a,f4.1,a)')'column c1 = ( ',bimmax,' - c1 )'
868 write(ifhi,'(a)') 'column c2 = ( c2 * 0.02 )'
869 write(ifhi,'(a)') 'input na50 ratio-b plot 0'
871 write(ifhi,'(a)') 'closehisto plot 0'
877 write(ifhi,'(a)') 'zone 3 4 1'
879 bim=(nb-0.5)*bimmax/mxbim
880 write(ifhi,'(a)') 'openhisto'
881 write(ifhi,'(a)') 'htyp lin xmod lin ymod lin'
882 write(ifhi,'(a,f5.2,a)')'text .1 .90 "b= ',bim,' fm"'
883 write(ifhi,'(a)') 'text 0 0 "xaxis time t (fm)"'
884 write(ifhi,'(a)') 'text 0 0 "yaxis J(b,t) / J"'
885 write(ifhi,'(a,2e11.3)')'xrange',taumi,taumi+ntjpsi*delt
886 write(ifhi,'(3a)') 'yrange',' 0 ',' auto'
887 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
888 write(ifhi,'(a)') 'array 4'
890 tau=taumi+(j-0.5)*delt
891 write(ifhi,'(4e12.4)')tau,float(jjjtot(nb,j))/nevent,0.,nevent
893 write(ifhi,'(a)') ' endarray'
894 write(ifhi,'(a)') 'closehisto plot 0'
897 c nr of nucleons vs t
898 c -------------------
901 write(ifhi,'(a)') 'zone 3 4 1'
903 bim=(nb-0.5)*bimmax/mxbim
904 write(ifhi,'(a)') 'openhisto'
905 write(ifhi,'(a)') 'htyp lin xmod lin ymod lin'
906 write(ifhi,'(a,f5.2,a)')'text .1 .90 "b= ',bim,' fm"'
907 write(ifhi,'(a)') 'text 0 0 "xaxis time t (fm)"'
908 write(ifhi,'(a)') 'text 0 0 "yaxis N(b,t) / J"'
909 write(ifhi,'(a,2e11.3)')'xrange',taumi,taumi+ntjpsi*delt
910 write(ifhi,'(3a)')'yrange',' 0 ',' auto'
911 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
912 write(ifhi,'(a)') 'array 4'
914 tau=taumi+(j-0.5)*delt
916 if(jjjtot(nb,j).gt.0)rat=nnucl(nb,j)/float(jjjtot(nb,j))
917 write(ifhi,'(4e12.4)')tau,rat,0.,float(jjjtot(nb,j))
919 write(ifhi,'(a)') ' endarray'
920 write(ifhi,'(a)') 'closehisto plot 0'
924 c nr of close nucleons vs t
925 c -------------------------
928 write(ifhi,'(a)') 'zone 3 4 1'
930 bim=(nb-0.5)*bimmax/mxbim
931 write(ifhi,'(a)') 'openhisto'
932 write(ifhi,'(a)') 'htyp lin xmod lin ymod lin'
933 write(ifhi,'(a,f5.2,a)')'text .1 .90 "b= ',bim,' fm"'
934 write(ifhi,'(a)') 'text 0 0 "xaxis time t (fm)"'
935 write(ifhi,'(a)') 'text 0 0 "yaxis Nclose(b,t) / J"'
936 write(ifhi,'(a,2e11.3)')'xrange',taumi,taumi+ntjpsi*delt
937 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
938 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
939 write(ifhi,'(a)') 'array 4'
941 tau=taumi+(j-0.5)*delt
943 if(jjjtot(nb,j).ne.0)rat=nclose(nb,j,1)/float(jjjtot(nb,j))
944 write(ifhi,'(4e12.4)')tau,rat,0.,float(jjjtot(nb,j))
946 write(ifhi,'(a)') ' endarray'
947 write(ifhi,'(a)') 'closehisto plot 0'
955 write(ifhi,'(a)') 'zone 3 4 1'
957 bim=(nb-0.5)*bimmax/mxbim
958 write(ifhi,'(a)') 'openhisto'
959 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
960 write(ifhi,'(a,f5.2,a)')'text .1 .90 "b= ',bim,' fm"'
961 write(ifhi,'(a)') 'text 0 0 "xaxis time t (fm)"'
962 write(ifhi,'(a)') 'text 0 0 "yaxis D(b,t) / J"'
963 write(ifhi,'(a,2e11.3)')'xrange',taumi,taumi+ntjpsi*delt
964 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
965 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
966 write(ifhi,'(a)') 'array 4'
968 tau=taumi+(j-0.5)*delt
970 if(jjjtot(nb,j).ne.0)rat=ndrop(nb,j)/float(jjjtot(nb,j))
971 write(ifhi,'(4e12.4)')tau,rat,0.,float(jjjtot(nb,j))
973 write(ifhi,'(a)') ' endarray'
974 write(ifhi,'(a)') 'closehisto plot 0'
982 write(ifhi,'(a)') 'zone 3 4 1'
984 bim=(nb-0.5)*bimmax/mxbim
985 write(ifhi,'(a)') 'openhisto'
986 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
987 write(ifhi,'(a,f5.2,a)')'text .1 .90 "b= ',bim,' fm"'
988 write(ifhi,'(a)') 'text 0 0 "xaxis time t (fm)"'
989 write(ifhi,'(a)') 'text 0 0 "yaxis mass*D(b,t) / J"'
990 write(ifhi,'(a,2e11.3)')'xrange',taumi,taumi+ntjpsi*delt
991 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
992 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
993 write(ifhi,'(a)') 'array 4'
995 tau=taumi+(j-0.5)*delt
997 if(jjjtot(nb,j).ne.0)rat=ndrop0(nb,j)/float(jjjtot(nb,j))
998 write(ifhi,'(4e12.4)')tau,rat,0.,float(jjjtot(nb,j))
1000 write(ifhi,'(a)') ' endarray'
1001 write(ifhi,'(a)') 'closehisto plot 0'
1005 c$$$c assymetry and mass of droplets
1006 c$$$c ------------------
1008 c$$$ if(jpsidr.eq.1)then
1010 c$$$ bim=(nb-0.5)*bimmax/mxbim
1011 c$$$ write(ifhi,'(a)') 'zone 3 4 1'
1012 c$$$ do nt=40,150,10
1013 c$$$ tau=taumi+(nt-0.5)*delt
1015 c$$$ write(ifhi,'(a)') 'openhisto'
1016 c$$$ write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1017 c$$$ write(ifhi,*) 'text .1 .90 "b= ',bim,' fm ','t=',tau,'"'
1018 c$$$ write(ifhi,'(a)') 'text 0 0 "xaxis mass "'
1019 c$$$ write(ifhi,'(a)') 'text 0 0 "yaxis assym"'
1020 c$$$ write(ifhi,'(a,2e11.3)')'xrange ',0.,40.
1021 c$$$ write(ifhi,'(a,2e11.3)')'yrange ',-5.,5.
1022 c$$$ write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1023 c$$$ write(ifhi,'(a,i)') 'set ityp2d 5'
1024 c$$$ write(ifhi,'(a,i)') 'array2d ',mxmass
1029 c$$$ rat=float(ndrp2(nb,nt,j,i))
1030 c$$$ & /zevent ! nevent
1031 c$$$ & /(40./20) ! mass-bin
1032 c$$$ & /(10./20) ! log(assy)-bin
1034 c$$$ write (ifhi,*) rat
1038 c$$$ write(ifhi,'(a)') ' endarray'
1039 c$$$ write(ifhi,'(a)') 'closehisto plot2d'
1044 c$$$c volume and mass of droplets
1045 c$$$c ------------------
1047 c$$$ if(jpsidr.eq.1)then
1049 c$$$ bim=(nb-0.5)*bimmax/mxbim
1050 c$$$ write(ifhi,'(a)') 'zone 3 4 1'
1051 c$$$ do nt=40,150,10
1052 c$$$ tau=taumi+(nt-0.5)*delt
1054 c$$$ write(ifhi,'(a)') 'openhisto'
1055 c$$$ write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1056 c$$$ write(ifhi,*) 'text .1 .90 "b= ',bim,' fm ','t=',tau,'"'
1057 c$$$ write(ifhi,'(a)') 'text 0 0 "xaxis mass "'
1058 c$$$ write(ifhi,'(a)') 'text 0 0 "yaxis volume"'
1059 c$$$ write(ifhi,'(a,2e11.3)')'xrange ',0.,40.
1060 c$$$ write(ifhi,'(a,2e11.3)')'yrange ',-2.,3.
1061 c$$$ write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1062 c$$$ write(ifhi,'(a,i)') 'array2d ',mxmass
1067 c$$$ rat=float(ndrop3(nb,nt,j,i))
1068 c$$$ & /zevent ! nevent
1069 c$$$ & /(40./20) ! mass-bin
1070 c$$$ & /(5./20) ! log(v)-bin
1072 c$$$ write (ifhi,*) rat
1076 c$$$ write(ifhi,'(a)') ' endarray'
1077 c$$$ write(ifhi,'(a)') 'closehisto plot2d'
1082 c$$$c xy of droplets
1083 c$$$c ------------------
1085 c$$$ if(jpsidr.eq.1)then
1086 c$$$ write(ifhi,'(a)') 'zone 3 4 1'
1088 c$$$ bim=(nb-0.5)*bimmax/mxbim
1089 c$$$ do nt=40,150,10
1090 c$$$ tau=taumi+(nt-0.5)*delt
1091 c$$$ write(ifhi,'(a)') 'openhisto'
1092 c$$$ write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1093 c$$$ write(ifhi,*) 'text .1 .90 "xy b= ',bim,' fm ','t=',tau,'"'
1094 c$$$ write(ifhi,'(a)') 'text 0 0 "xaxis x "'
1095 c$$$ write(ifhi,'(a)') 'text 0 0 "yaxis y "'
1096 c$$$ write(ifhi,'(a,2e11.3)')'xrange ',a4min,a4max
1097 c$$$ write(ifhi,'(a,2e11.3)')'yrange ',a4min,a4max
1098 c$$$ write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1099 c$$$ write(ifhi,'(a,i)') 'array2d ',nxmdk
1103 c$$$ rat=xydens(nt,nb,i,j)
1104 c$$$ & /zevent ! nevent
1105 c$$$ & /((a4max-a4min)/float(nxmdk)) ! x-bin
1106 c$$$ & /((a4max-a4min)/float(nxmdk)) ! y-bin
1107 c$$$c...............& /1. ! b-bin
1108 c$$$ write (ifhi,*) rat
1111 c$$$ write(ifhi,'(a)') ' endarray'
1112 c$$$ write(ifhi,'(a)') 'closehisto plot2d'
1118 c$$$c$$$c.....michael-verteilung.........................................
1119 c$$$c$$$ write(ifhi,'(a)') 'zone 3 4 1'
1120 c$$$c$$$ do j=1,ntjpsi
1121 c$$$c$$$ tau=taumi+(j-0.5)*delt
1123 c$$$c$$$ write(ifhi,'(a)') 'openhisto'
1124 c$$$c$$$ write(ifhi,'(a)') 'htyp lin xmod lin ymod log'
1125 c$$$c$$$ write(ifhi,'(a,f5.2,a)')'text .1 .90 "tau= ',tau,' fm"'
1126 c$$$c$$$ write(ifhi,'(a)') 'text 0 0 "xaxis mass t (fm)"'
1127 c$$$c$$$ write(ifhi,'(a)') 'text 0 0 "yaxis Nclose(b,t) / J"'
1128 c$$$c$$$ write(ifhi,'(a,2e11.3)')'xrange',a6min,a6max
1129 c$$$c$$$ write(ifhi,'(3a)')'yrange',' 0 ',' auto '
1130 c$$$c$$$ write(ifhi,'(a)') 'array 2'
1131 c$$$c$$$ do k=1,mxmass
1133 c$$$c$$$ amass=(k-0.5)/(mxmass)*(a6max-a6min)+a6min
1134 c$$$c$$$ rat=ami(j,k)/zevent/(a6max-a6min)*mxmass
1135 c$$$c$$$ write(ifhi,'(2e12.4)')amass,rat
1137 c$$$c$$$ write(ifhi,'(a)') ' endarray'
1138 c$$$c$$$ write(ifhi,'(a)') 'closehisto plot 0'
1144 c$$$ if(jpsidr.eq.1)then
1145 c$$$ write(ifhi,'(a)') 'zone 3 4 1'
1147 c$$$ bim=(nb-0.5)*bimmax/mxbim
1148 c$$$ write(ifhi,'(a)') 'openhisto'
1149 c$$$ write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1150 c$$$ write(ifhi,*) 'text .1 .90 "xy b= ',bim,' fm ','t=',tau,'"'
1151 c$$$ write(ifhi,'(a)') 'text 0 0 "xaxis x "'
1152 c$$$ write(ifhi,'(a)') 'text 0 0 "yaxis y "'
1153 c$$$ write(ifhi,'(a,2e11.3)')'xrange ',a4min,a4max
1154 c$$$ write(ifhi,'(a,2e11.3)')'yrange ',a4min,a4max
1155 c$$$ write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1156 c$$$ write(ifhi,'(a,i)') 'array2d ',nxmdk
1160 c$$$ rat=xys(nb,i,j)
1161 c$$$ & /zevent ! nevent
1162 c$$$ & /((a5max-a5min)/float(nxmdk)) ! x-bin
1163 c$$$ & /((a5max-a5min)/float(nxmdk)) ! y-bin
1164 c$$$c...............& /1. ! b-bin
1165 c$$$ write (ifhi,*) rat
1168 c$$$ write(ifhi,'(a)') ' endarray'
1169 c$$$ write(ifhi,'(a)') 'closehisto plot2d'
1174 c fraction of jpsis in a droplet
1175 c ------------------------------
1178 write(ifhi,'(a)') 'zone 3 4 1'
1180 bim=(nb-0.5)*bimmax/mxbim
1181 write(ifhi,'(a)') 'openhisto'
1182 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1183 write(ifhi,'(a,f5.2,a)')'text .1 .90 "b= ',bim,' fm"'
1184 write(ifhi,'(a)') 'text 0 0 "xaxis time t (fm)"'
1185 write(ifhi,'(a)') 'text 0 0 "yaxis Jdrop(b,t) / J"'
1186 write(ifhi,'(a,2e11.3)')'xrange',taumi,taumi+ntjpsi*delt
1187 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
1188 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1189 write(ifhi,'(a)') 'array 4'
1191 tau=taumi+(j-0.5)*delt
1193 if(jjjtot(nb,j).ne.0)rat=jjjdro(nb,j)/float(jjjtot(nb,j))
1194 write(ifhi,'(4e12.4)')tau,rat,0.,float(jjjtot(nb,j))
1196 write(ifhi,'(a)') ' endarray'
1197 write(ifhi,'(a)') 'closehisto plot 0'
1201 c fraction of jpsis with taud gt tauc
1202 c -----------------------------------
1205 write(ifhi,'(a)') 'zone 2 4 1'
1207 tauc=ntauc*(taudmx/mxtauc)
1208 write(ifhi,'(a)') 'openhisto'
1209 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1210 write(ifhi,'(a,f5.2,a)')'text .1 .90 "tauc= ',tauc,' fm/c"'
1211 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
1213 *'text 0 0 "yaxis J(b, taud) / J(b)"'
1214 write(ifhi,'(a,2e11.3)')'xrange',0.,bimmax
1215 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
1216 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1217 write(ifhi,'(a)') 'array 4'
1219 bim=(j-0.5)*bimmax/mxbim
1221 if(jjtot(j).gt.0.)rat=float(jjjtau(j,ntauc))/jjtot(j)
1222 write(ifhi,'(4e12.4)')bimmax-bim,rat,0.,float(jjtot(j))
1224 write(ifhi,'(a)') ' endarray'
1225 write(ifhi,'(a)') 'closehisto plot 0'
1229 c droplet survival ratio
1233 write(ifhi,'(a)') 'zone 2 4 1'
1235 tauc=ntauc*(taudmx/mxtauc)
1236 write(ifhi,'(a)') 'openhisto'
1237 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1238 write(ifhi,'(a,f5.2,a)')'text .1 .90 "tauc= ',tauc,' fm/c"'
1239 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
1240 write(ifhi,'(a)') 'text 0 0 "yaxis droplet survival ratio"'
1241 write(ifhi,'(a,2e11.3)')'xrange',0.,bimmax
1242 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
1243 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1244 write(ifhi,'(a)') 'array 4'
1246 bim=(j-0.5)*bimmax/mxbim
1248 if(jjtot(j).gt.0.)rat=float(jjtot(j)-jjjtau(j,ntauc))/jjtot(j)
1249 write(ifhi,'(4e12.4)')bimmax-bim,rat,0.,float(jjtot(j))
1251 write(ifhi,'(a)') ' endarray'
1252 write(ifhi,'(a)') 'closehisto plot 0'
1256 c total approx. survival ratio
1260 write(ifhi,'(a)') 'zone 2 4 1'
1262 tauc=ntauc*(taudmx/mxtauc)
1263 write(ifhi,'(a)') 'openhisto'
1264 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1265 write(ifhi,'(a,f5.2,a)')'text .1 .90 "tauc= ',tauc,' fm/c"'
1266 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
1267 write(ifhi,'(a)') 'text 0 0 "yaxis tot. ap. survival ratio"'
1268 write(ifhi,'(a,2e11.3)')'xrange',0.,bimmax
1269 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
1270 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1271 write(ifhi,'(a)') 'array 4'
1273 bim=(j-0.5)*bimmax/mxbim
1275 if(jjtot(j).gt.0.)rat=float(jjtot(j)-jjjtau(j,ntauc))/jjtot(j)
1276 write(ifhi,'(4e12.4)')bimmax-bim,rat,0.,float(jjtot(j))
1278 write(ifhi,'(a)') ' endarray'
1279 write(ifhi,'(a)') 'closehisto '
1280 if(maproj.eq.208.and.matarg.eq.208)then
1281 write(ifhi,'(a,a)') 'openhisto htyp lfu input jpbpb',
1282 & ' j-nucl mult plot 0- '
1283 write(ifhi,'(a)')'openhisto htyp ldo input jpbpb j-nucl plot 0- '
1284 write(ifhi,'(a)') 'openhisto'
1285 write(ifhi,'(a)') 'set fmsc 1.0'
1286 write(ifhi,'(a)') 'column c1 = ( 11.9 - c1 )'
1287 write(ifhi,'(a)') 'column c2 = ( c2 * 0.019 )'
1288 write(ifhi,'(a)') 'input na50 ratio-b plot 0'
1289 elseif(maproj.eq.32.and.matarg.eq.32)then
1290 write(ifhi,'(a,a)') 'openhisto htyp lfu input jss',
1291 & ' j-nucl mult plot 0- '
1292 write(ifhi,'(a)')'openhisto htyp ldo input jss j-nucl plot 0 '
1297 c total survival ratio
1301 write(ifhi,'(a)') 'zone 2 4 1'
1303 tauc=ntauc*(taudmx/mxtauc)
1304 write(ifhi,'(a)') 'openhisto'
1305 write(ifhi,'(a)') 'htyp lfu xmod lin ymod lin'
1306 write(ifhi,'(a,f5.2,a)')'text .1 .90 "tauc= ',tauc,' fm/c"'
1307 write(ifhi,'(a)') 'text 0 0 "xaxis bmax-b (fm)"'
1308 write(ifhi,'(a)') 'text 0 0 "yaxis total survival ratio"'
1309 write(ifhi,'(a,2e11.3)')'xrange',0.,bimmax
1310 write(ifhi,'(3a)')'yrange',' 0 ',' auto '
1311 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1312 write(ifhi,'(a)') 'array 4'
1314 bim=(j-0.5)*bimmax/mxbim
1316 if(jjtot(j).gt.0.)rat=float(jjtot(j)-jjjnt(j,ntauc))/jjtot(j)
1317 write(ifhi,'(4e12.4)')bimmax-bim,rat,0.,float(jjtot(j))
1319 write(ifhi,'(a)') ' endarray'
1320 write(ifhi,'(a)') 'closehisto plot 0-'
1322 write(ifhi,'(a)') 'openhisto'
1323 write(ifhi,'(a)') 'htyp ldo xmod lin ymod lin'
1324 write(ifhi,'(a)') 'columnweight 4 column c4 = ( 0 ) '
1325 write(ifhi,'(a)') 'array 4'
1327 bim=(j-0.5)*bimmax/mxbim
1329 if(jjtot(j).gt.0.)rat=float(jjtot(j)-jjnuc(j))/jjtot(j)
1330 write(ifhi,'(4e12.4)')bimmax-bim,rat,0.,float(jjtot(j))
1332 write(ifhi,'(a)') ' endarray'
1333 if(maproj.eq.208.and.matarg.eq.208)then
1334 write(ifhi,'(a)') 'closehisto plot 0-'
1335 write(ifhi,'(a)') 'openhisto'
1336 write(ifhi,'(a)') 'set fmsc 1.0'
1337 write(ifhi,'(a)') 'column c1 = ( 11.9 - c1 )'
1338 write(ifhi,'(a)') 'column c2 = ( c2 * 0.019 )'
1339 write(ifhi,'(a)') 'input na50 ratio-b plot 0'
1341 write(ifhi,'(a)') ' closehisto plot 0'