c Read file created with MARS and write for003.dat for ICOOL (many) implicit double precision (a-h,o-z) c real*8 xp,pp,pol,tp,evtwt,tbref character*80 probtitle dimension xp(3),pp(3),pol(3),xbref(3),pbref(3),xmass(12) data (xmass(i), i=1,12) /0.9383d0,0.93956d0,0.1396d0,0.1396d0, ! 0.4937d0,0.4937d0,0.1057d0,0.1057d0,0.d0,0.511d-3,0.511d-3, ! 0.9383d0/ c open(unit=20,file='proton.dat',status='unknown',iostat=ioc) open(unit=3,file='pion-pos.dat',status='unknown',iostat=ioc) open(unit=33,file='pion-neg.dat',status='unknown',iostat=ioc) open(unit=4,file='file1.dat',status='unknown',iostat=ioc) open(unit=5,file='file2.dat',status='unknown',iostat=ioc) open(unit=6,file='file3.dat',status='unknown',iostat=ioc) open(unit=7,file='file4.dat',status='unknown',iostat=ioc) open(unit=8,file='file5.dat',status='unknown',iostat=ioc) open(unit=9,file='file6.dat',status='unknown',iostat=ioc) open(unit=10,file='file7.dat',status='unknown',iostat=ioc) open(unit=11,file='file8.dat',status='unknown',iostat=ioc) open(unit=12,file='file9.dat',status='unknown',iostat=ioc) open(unit=13,file='file10.dat',status='unknown',iostat=ioc) open(unit=44,file='file41.dat',status='unknown',iostat=ioc) open(unit=45,file='file42.dat',status='unknown',iostat=ioc) open(unit=46,file='file43.dat',status='unknown',iostat=ioc) open(unit=47,file='file44.dat',status='unknown',iostat=ioc) open(unit=48,file='file45.dat',status='unknown',iostat=ioc) open(unit=49,file='file46.dat',status='unknown',iostat=ioc) open(unit=50,file='file47.dat',status='unknown',iostat=ioc) open(unit=51,file='file48.dat',status='unknown',iostat=ioc) open(unit=52,file='file49.dat',status='unknown',iostat=ioc) open(unit=53,file='file50.dat',status='unknown',iostat=ioc) if( ioc .ne. 0 ) go to 800 idum=77777 ipstart=1 ipstop=1000001 tbref=0.0d0 read(3,'(a80)') probtitle ! skip title card on beam input file read(3,*) xbref,pbref,tbref ! ref particle info do i=1,10 nfile=3+i write(nfile,'(a80)') probtitle ! skip title card on beam input file write(nfile,*) xbref,pbref,tbref ! ref particle info end do read(33,'(a80)') probtitle ! skip title card on beam input file read(33,*) xbref,pbref,tbref ! ref particle info do i=1,10 nfileq=43+i write(nfileq,'(a80)') probtitlen ! skip title card on beam input file write(nfileq,*) xbref,pbref,tbref ! ref particle info end do c do 200 ip=ipstart,ipstop ! loop over particles ! read(3,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol ! if( ioc .ne. 0 ) then ! eof reading FOR003 beam input go to 1900 end if c randomize files po=ran1(idum) if(po.le.0.1d0)then write(4,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.1d0.and.po.le.0.2d0)then write(5,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.2d0.and.po.le.0.3d0)then write(6,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.3d0.and.po.le.0.4d0)then write(7,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.4d0.and.po.le.0.5d0)then write(8,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.5d0.and.po.le.0.6d0)then write(9,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.6d0.and.po.le.0.7d0)then write(10,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.7d0.and.po.le.0.8d0)then write(11,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.8d0.and.po.le.0.9d0)then write(12,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.9d0.and.po.le.1.d0)then write(13,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol endif 200 continue 1900 continue do 400 ip=ipstart,ipstop ! loop over particles ! read(33,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol ! if( ioc .ne. 0 ) then ! eof reading FOR003 beam input go to 900 end if ! transformation here c randomize files po=ran1(idum) if(po.le.0.1d0)then write(44,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.1d0.and.po.le.0.2d0)then write(45,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.2d0.and.po.le.0.3d0)then write(46,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.3d0.and.po.le.0.4d0)then write(47,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.4d0.and.po.le.0.5d0)then write(48,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.5d0.and.po.le.0.6d0)then write(49,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.6d0.and.po.le.0.7d0)then write(50,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.7d0.and.po.le.0.8d0)then write(51,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.8d0.and.po.le.0.9d0)then write(52,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol else if(po.gt.0.9d0.and.po.le.1.d0)then write(53,*,iostat=ioc)ievt,ipnum,iptyp,ipflg,tp,evtwt,xp,pp, & pol endif 400 continue goto 900 800 continue c Error in input write(*,*)' <<<<< ERROR OPENING FILE >>>>>' write(2,*)' <<<<< ERROR OPENING FILE >>>>>' 900 continue stop end c *************************************************** FUNCTION ran1(idum) implicit double precision (a-h,o-z) INTEGER idum,IA,IM,IQ,IR,NTAB,NDIV PARAMETER (IA=16807,IM=2147483647,AM=1.d0/IM,IQ=127773,IR=2836, *NTAB=32,NDIV=1+(IM-1)/NTAB,EPS=2.3d-16,RNMX=1.d0-EPS) INTEGER j,k,iv(NTAB),iy SAVE iv,iy DATA iv /NTAB*0/, iy /0/ ! if (idum.le.0.or.iy.eq.0) then idum=max(-idum,1) do 11 j=NTAB+8,1,-1 k=idum/IQ idum=IA*(idum-k*IQ)-IR*k if (idum.lt.0) idum=idum+IM if (j.le.NTAB) iv(j)=idum 11 continue iy=iv(1) endif k=idum/IQ idum=IA*(idum-k*IQ)-IR*k if (idum.lt.0) idum=idum+IM j=1+iy/NDIV iy=iv(j) iv(j)=idum ran1=min(AM*iy,RNMX) return END