~maddevelopers/mg5amcnlo/3.0.2-alpha0

« back to all changes in this revision

Viewing changes to Template/Source/gen_ximprove.f

Added Template and HELAS into bzr

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      program gen_ximprove
 
2
c*****************************************************************************
 
3
c     Program to combine results from all of the different sub amplitudes 
 
4
c     and given total  cross section and error.
 
5
c*****************************************************************************
 
6
      implicit none
 
7
c
 
8
c     Constants
 
9
c
 
10
      character*(*) rfile
 
11
      parameter (rfile='results.dat')
 
12
      character*(*) symfile
 
13
      parameter (symfile='symfact.dat')
 
14
      integer   max_amps
 
15
      parameter (max_amps=9999)
 
16
      integer maxpara
 
17
      parameter (maxpara=1000)
 
18
 
 
19
      include 'run_config.inc'
 
20
c
 
21
c     global
 
22
c
 
23
      integer max_np
 
24
      common/max_np/max_np
 
25
 
 
26
c
 
27
c     local
 
28
c
 
29
      double precision xsec(max_amps), xerr(max_amps)
 
30
      double precision xerru(max_amps),xerrc(max_amps)
 
31
      double precision xmax(max_amps), eff(max_amps)
 
32
      double precision xlum(max_amps)
 
33
      double precision ysec, yerr, yeff, ymax
 
34
      double precision tsec, terr, teff, tmax, xi
 
35
      integer nw(max_amps), nevents(max_amps), maxit
 
36
      integer nunwgt(max_amps)
 
37
      character*80 fname, gname(max_amps)
 
38
      integer i,j,k,l,n,ipp
 
39
      double precision xtot,errtot,err_goal
 
40
      double precision errtotu,errtotc
 
41
      integer mfact(max_amps)
 
42
      logical parallel, gen_events
 
43
      character*20 param(maxpara),value(maxpara)
 
44
      integer npara, nreq, ngran
 
45
      integer ij, kl, iseed
 
46
      logical Gridpack,gridrun
 
47
 
 
48
c-----
 
49
c  Begin Code
 
50
c-----
 
51
      call load_para(npara,param,value)
 
52
      call get_logical(npara,param,value," gridpack ",gridpack,.false.)
 
53
      if (.not. Gridpack) then
 
54
         write(*,'(a,a)')'Enter fractional accuracy (<1)',
 
55
     &        ', or number events (>1) and max processes per job'
 
56
         read(*,*) err_goal, max_np
 
57
         parallel = .false.
 
58
         if (err_goal .lt. 1) then
 
59
            write(*,'(a,f8.2,a)') 'Running for accuracy of ',
 
60
     $           err_goal*100,'%'
 
61
            gen_events=.false.         
 
62
         elseif (err_goal .gt. 1) then
 
63
            write(*,'(a,f9.0,a)') 'Generating ',err_goal,
 
64
     &           ' unweighted events.'
 
65
            gen_events=.true.         
 
66
            err_goal = err_goal * 1.2 !Extra factor to ensure works
 
67
         else
 
68
            write(*,*) 'Error, need non_zero goal'
 
69
            stop
 
70
         endif
 
71
      else
 
72
         gen_events=.true.
 
73
         call get_integer(npara,param,value," gevents "  ,nreq  ,2000   )
 
74
         err_goal = 1.2*nreq
 
75
         call get_integer(npara,param,value," gseed "  ,iseed  ,4321   )
 
76
         call get_integer(npara,param,value," ngran "  ,ngran  , -1)
 
77
         if (ngran.eq.-1) ngran = int(sqrt(real(nreq)))
 
78
         write(*,*) "Running on Grid to generate ",nreq," additional events"
 
79
         write(*,*) "   with granularity equal to ",ngran
 
80
c
 
81
c     TJS 3/13/2008
 
82
c     Modified to allow for more sequences
 
83
c     iseed can be between 0 and 31328*30081
 
84
c     before patern repeats
 
85
c
 
86
         ij=1802 + mod(iseed,30081)
 
87
         kl=9373 + (iseed/31328)
 
88
c         write(*,'($a,i6,a3,i6)') 'Using random seed offsets',jconfig," : ",ioffset
 
89
c         write(*,*) ' with seed', iseed
 
90
         do while (ij .gt. 31328)
 
91
            ij = ij - 31328
 
92
         enddo
 
93
         do while (kl .gt. 30081)
 
94
            kl = kl - 30081
 
95
         enddo
 
96
         write(*,*) "Using random seeds",ij,kl
 
97
        call rmarin(ij,kl)         
 
98
      endif
 
99
      open(unit=15,file=symfile,status='old',err=999)
 
100
      errtot=0d0
 
101
      errtotu=0d0
 
102
      errtotc=0d0
 
103
      xtot = 0d0
 
104
      i = 0
 
105
      do while (.true.)
 
106
         read(15,*,err=99,end=99) xi,j
 
107
         if (j .gt. 0) then
 
108
            i = i+1
 
109
            if ( (xi-int(xi+.01)) .lt. 1d-5) then
 
110
               n = int(xi+.01)
 
111
               if (n .lt. 10) then
 
112
                  write(fname,'(a,i1,a,a)') 'G',n,'/',rfile
 
113
               else if (n .lt. 100) then
 
114
                  write(fname,'(a,i2,a,a)') 'G',n,'/',rfile
 
115
               else if (n .lt. 1000) then
 
116
                  write(fname,'(a,i3,a,a)') 'G',n,'/',rfile
 
117
               else if (n .lt. 10000) then
 
118
                  write(fname,'(a,i4,a,a)') 'G',n,'/',rfile
 
119
               endif
 
120
            else
 
121
               if (xi .lt. 10) then
 
122
                  write(fname,'(a,f5.3,a,a)') 'G',xi,'/',rfile
 
123
               else if (xi .lt. 100) then
 
124
                  write(fname,'(a,f6.3,a,a)') 'G',xi,'/',rfile
 
125
               else if (xi .lt. 1000) then
 
126
                  write(fname,'(a,f7.3,a,a)') 'G',xi,'/',rfile
 
127
               else if (xi .lt. 10000) then
 
128
                  write(fname,'(a,f8.3,a,a)') 'G',xi,'/',rfile
 
129
               endif
 
130
c              write(*,*) 'log name ',fname
 
131
            endif
 
132
         endif
 
133
         if (j .gt. 0) then
 
134
            gname(i)=fname
 
135
            nevents(i)=0d0
 
136
            xsec(i)=0d0
 
137
            xerr(i)=0d0
 
138
            nw(i)  =0d0
 
139
            mfact(i)=j
 
140
 
 
141
c
 
142
c     Read in integration data from run
 
143
c
 
144
            open(unit=25,file=fname,status='old',err=95)
 
145
            read(25,*) xsec(i),xerru(i),xerrc(i),nevents(i),nw(i),maxit,
 
146
     &           nunwgt(i),xlum(i)
 
147
            if (xsec(i) .eq. 0d0) xlum(i)=1d99     !zero cross section
 
148
            xlum(i) = xlum(i)/1000   !convert to fb^-1 
 
149
            xerr(i)=sqrt(xerru(i)**2+xerrc(i)**2)
 
150
            if (.false.) then
 
151
c            maxit = 2
 
152
               tmax = -1d0
 
153
               terr = 0d0
 
154
               teff = 0d0
 
155
               tsec = 0d0
 
156
               do k=1,maxit
 
157
                  read(25,*,err=92) l,ysec,yerr,yeff,ymax
 
158
                  if (k .gt. 1) tmax = max(tmax,ymax)
 
159
                  tsec = tsec + ysec
 
160
                  terr = terr +yerr**2
 
161
                  teff = teff + yeff
 
162
               enddo
 
163
 92            maxit = k-1      !In case of error reading file
 
164
               xsec(i)=tsec/maxit
 
165
               xerr(i)=sqrt(terr)/maxit
 
166
               xmax(i)=tmax/xsec(i)
 
167
            endif
 
168
c            tmax
 
169
            xmax(i) = -1d0
 
170
            xsec(i) = xsec(i)*mfact(i)
 
171
            xerr(i) = xerr(i)*mfact(i)
 
172
            xerru(i) = xerru(i)*mfact(i)
 
173
            xerrc(i) = xerrc(i)*mfact(i)
 
174
            xlum(i) = xlum(i)/mfact(i)
 
175
            xtot = xtot+ xsec(i)
 
176
            eff(i)= xerr(i)*sqrt(real(nevents(i)))/xsec(i)
 
177
            errtotu = errtotu+(xerru(i))**2
 
178
            errtotc = errtotc+(xerrc(i))
 
179
c            xtot = xtot+ xsec(i)*mfact(i)
 
180
c            eff(i)= xerr(i)*sqrt(real(nevents(i)))/xsec(i)
 
181
c            errtot = errtot+(mfact(i)*xerr(i))**2
 
182
 95         close(25)
 
183
c            write(*,*) i,maxit,xsec(i), eff(i)
 
184
         else
 
185
c            i=i-1   !This is for case w/ B.W. and optimization
 
186
         endif
 
187
      enddo
 
188
 99   close(15)
 
189
      errtot=sqrt(errtotc**2+errtotu)
 
190
      if ( .not. gen_events) then
 
191
         call write_bash(xsec,xerru,xerrc,xtot,mfact,err_goal,
 
192
     $        i,nevents,gname)
 
193
      else
 
194
         open(unit=25,file='../results.dat',status='old',err=199)
 
195
         write(*,'(a,e12.3)') 'Reading total xsection ',xtot
 
196
         read(25,*) xtot
 
197
         write(*,'(e12.3)') xtot
 
198
 199     close(25)
 
199
         if (gridpack) then
 
200
            call write_gen_grid(err_goal,dble(ngran),i,nevents,gname,xlum,xtot,mfact,xsec)
 
201
         else
 
202
            call write_gen(err_goal,i,nevents,gname,xlum,xtot,mfact,xsec)
 
203
         endif
 
204
      endif
 
205
      stop
 
206
 999  write(*,*) 'error'
 
207
      end
 
208
 
 
209
 
 
210
      subroutine write_bash(xsec,xerru,xerrc,xtot,
 
211
     $     mfact,err_goal,ng,jpoints,gn)
 
212
c*****************************************************************************
 
213
c     Writes out bash commands for running each channel as needed.
 
214
c*****************************************************************************
 
215
      implicit none
 
216
c
 
217
c     Constants
 
218
c
 
219
      include 'run_config.inc'
 
220
      integer   max_amps
 
221
      parameter (max_amps=9999)
 
222
c      integer    max_np
 
223
c      parameter (max_np = 30)
 
224
c
 
225
c     global
 
226
c
 
227
      integer max_np
 
228
      common/max_np/max_np
 
229
c
 
230
c     Arguments
 
231
c
 
232
      double precision xsec(max_amps), xerru(max_amps),xerrc(max_amps)
 
233
      double precision err_goal,xtot
 
234
      integer mfact(max_amps),jpoints(max_amps)
 
235
      integer ng
 
236
      character*(80) gn(max_amps)
 
237
c
 
238
c     Local
 
239
c
 
240
      integer i,j,k, io(max_amps), npoints, ip, np
 
241
      double precision xt(max_amps),elimit
 
242
      double precision yerr,ysec,rerr
 
243
      logical fopened
 
244
c-----
 
245
c  Begin Code
 
246
c-----
 
247
      fopened = .false.
 
248
      k=0
 
249
      do j=1,ng
 
250
         if (mfact(j) .gt. 0) k=k+1
 
251
         io(j) = j
 
252
         xt(j)= sqrt((xerru(j)+xerrc(j)**2)*mfact(j))     !sort by error
 
253
      enddo
 
254
c
 
255
c     Let's redetermine err_goal based on luminosity
 
256
c
 
257
      write(*,*) 'Cross section pb',xtot
 
258
      write(*,*) 'Desired Goal',err_goal      
 
259
      write(*,*) 'Total Error',err_goal
 
260
c      elimit = err_goal*xtot/sqrt(real(k)) !Equal contributions from each
 
261
      elimit = err_goal*xtot/real(k) !Equal contributions from each
 
262
 
 
263
      call sort2(xt,io,ng)
 
264
      k=1
 
265
      xt(ng+1) = 0
 
266
      do while( xt(k) .gt. abs(elimit))  !abs is just in case elimit<0 by mistake
 
267
         k=k+1
 
268
      enddo
 
269
      k=k-1
 
270
      rerr=0d0
 
271
      do j=k+1,ng
 
272
c         rerr = rerr+xt(j)**2
 
273
         rerr = rerr+xt(j)
 
274
      enddo
 
275
      rerr=rerr**2
 
276
c      write(*,*) 'Number of diagrams to fix',k
 
277
c
 
278
c     Now readjust because most don't contribute
 
279
c
 
280
      elimit = sqrt((err_goal*xtot)**2 - rerr)/sqrt(real(k))
 
281
 
 
282
      
 
283
      np = max_np
 
284
      do i=1,k
 
285
 
 
286
c         yerr = xerr(io(i))*mfact(io(i))
 
287
         yerr = xt(i)
 
288
c         write(*,*) i,xt(i),elimit
 
289
         if (yerr .gt. elimit) then
 
290
 
 
291
         ysec = xsec(io(i)) + yerr
 
292
         npoints=(0.2d0)*jpoints(io(i))*(yerr/elimit)**2
 
293
         npoints = max(npoints,min_events)
 
294
         npoints = min(npoints,max_events)
 
295
c         np = np + 3*npoints
 
296
         np = np +1
 
297
         if (np .gt. max_np) then
 
298
            if (fopened) then
 
299
               write(26,15) 'rm -f run.$script >&/dev/null'
 
300
               write(26,15) 'touch done.$script >&/dev/null'
 
301
               close(26)
 
302
            endif
 
303
            fopened=.true.
 
304
            call open_bash_file(26)
 
305
c            np = 3*npoints
 
306
            np = 1
 
307
         endif
 
308
 
 
309
         ip = index(gn(io(i)),'/')
 
310
         write(*,*) 'Channel ',gn(io(i))(2:ip-1),
 
311
     $        yerr, jpoints(io(i)),npoints
 
312
 
 
313
         ip = index(gn(io(i)),'/')
 
314
         write(26,'(2a)') 'j=',gn(io(i))(1:ip-1)
 
315
         if (.false.) then
 
316
         if (io(i) .lt. 10) then
 
317
            write(26,'(a,i1)') 'j=G',io(i)
 
318
         elseif (io(i) .lt. 100) then
 
319
            write(26,'(a,i2)') 'j=G',io(i)
 
320
         elseif (io(i) .lt. 1000) then
 
321
            write(26,'(a,i3)') 'j=G',io(i)
 
322
         elseif (io(i) .lt. 10000) then
 
323
            write(26,'(a,i4)') 'j=G',io(i)
 
324
         endif
 
325
         endif
 
326
c
 
327
c     Determine estimates for getting the desired accuracy
 
328
c
 
329
 
 
330
c
 
331
c     Now write the commands
 
332
c      
 
333
         write(26,20) 'echo $j'
 
334
         write(26,20) 'if [[ ! -e $j ]]; then'
 
335
         write(26,25) 'mkdir $j'
 
336
         write(26,20) 'fi'
 
337
         write(26,20) 'cd $j'
 
338
         write(26,20) 'rm -f $k'
 
339
 
 
340
         write(26,'(5x,a,2i8,a)') 'echo "',npoints,max_iter,
 
341
     $        '" >& input_sg.txt' 
 
342
         write(26,'(5x,a,f8.3,a)') 'echo "',max(elimit/ysec,0.001d0),
 
343
     $        '" >> input_sg.txt'
 
344
         write(26,'(5x,a)') 'echo "2" >> input_sg.txt'  !Grid
 
345
         write(26,'(5x,a)') 'echo "1" >> input_sg.txt'  !Suppress
 
346
         write(26,'(5x,a,i4,a)') 'echo "',nhel_refine,
 
347
     &        '"  >> input_sg.txt' !Helicity 
 
348
         write(26,'(5x,3a)')'echo "',gn(io(i))(2:ip-1),
 
349
     $        '" >>input_sg.txt'
 
350
         write(26,20) 'time ../madevent >> $k <input_sg.txt'
 
351
         write(26,20) 'mv ftn26 ftn25'
 
352
c         write(26,20) 'rm ftn26'
 
353
         write(26,20) 'cat $k >> log.txt'
 
354
         write(26,20) 'cd ../'
 
355
      endif
 
356
      enddo  !Loop over diagrams
 
357
      if (fopened) then
 
358
         write(26,15) 'rm -f run.$script >&/dev/null'
 
359
         write(26,15) 'touch done.$script >&/dev/null'
 
360
         close(26)
 
361
      endif
 
362
      fopened=.false.
 
363
 15   format(a)
 
364
 20   format(5x,a)
 
365
 25   format(10x,a)
 
366
 999  close(26)
 
367
      end
 
368
 
 
369
 
 
370
      subroutine open_bash_file(lun)
 
371
c***********************************************************************
 
372
c     Opens bash file for looping including standard header info
 
373
c     which can be used with pbs, or stand alone
 
374
c***********************************************************************
 
375
      implicit none
 
376
c
 
377
c     Constants
 
378
c
 
379
      include 'run_config.inc'
 
380
c
 
381
c     Arguments
 
382
c
 
383
      integer lun
 
384
c
 
385
c     local
 
386
c
 
387
      character*30 fname
 
388
      integer ic
 
389
 
 
390
      data ic/0/
 
391
c-----
 
392
c  Begin Code
 
393
c-----
 
394
      ic=ic+1
 
395
      fname='ajob'
 
396
      if (ic .lt. 10) then
 
397
         write(fname(5:5),'(i1)') ic
 
398
      elseif (ic .lt. 100) then
 
399
         write(fname(5:6),'(i2)') ic
 
400
      elseif (ic .lt. 1000) then
 
401
         write(fname(5:7),'(i3)') ic
 
402
      elseif (ic .lt. 10000) then
 
403
         write(fname(5:8),'(i4)') ic
 
404
      else
 
405
         write(*,*) 'Error too many jobs in gen_ximprove',ic
 
406
         stop
 
407
      endif
 
408
      write(*,*) 'Opening file ',fname
 
409
 
 
410
      open (unit=26, file = fname, status='unknown')
 
411
      write(26,15) '#!/bin/bash'
 
412
      write(26,15) '#PBS -q ' // PBS_QUE
 
413
      write(26,15) '#PBS -o /dev/null'
 
414
      write(26,15) '#PBS -e /dev/null'
 
415
      write(26,15) 'if [[ "$PBS_O_WORKDIR" != "" ]]; then' 
 
416
      write(26,15) '    cd $PBS_O_WORKDIR'
 
417
      write(26,15) 'fi'
 
418
      write(26,15) 'k=run1_app.log'
 
419
      write(lun,15) 'script=' // fname
 
420
      write(lun,15) 'rm -f wait.$script >& /dev/null'
 
421
      write(lun,15) 'touch run.$script'
 
422
 15   format(a)
 
423
      end
 
424
 
 
425
      subroutine close_bash_file(lun)
 
426
c***********************************************************************
 
427
c     Closes bash file
 
428
c***********************************************************************
 
429
      implicit none
 
430
c
 
431
c     Constants
 
432
c
 
433
c
 
434
c     Arguments
 
435
c
 
436
      integer lun
 
437
c
 
438
c     local
 
439
c
 
440
      character*30 fname
 
441
      integer ic
 
442
 
 
443
      data ic/0/
 
444
c-----
 
445
c  Begin Code
 
446
c-----
 
447
 
 
448
c      write(lun,'(a)') ')'
 
449
c
 
450
c     Now write the commands
 
451
c      
 
452
c      write(lun,20) 'echo $i'
 
453
c      write(lun,20) 'j=G$i'
 
454
c      write(lun,20) 'if (! -e $j) then'
 
455
c      write(lun,25) 'mkdir $j'
 
456
c      write(lun,20) 'endif'
 
457
c      write(lun,20) 'cd $j'
 
458
c      write(lun,20) 'rm -f ftn25 ftn99'
 
459
c      write(lun,20) 'rm -f $k'
 
460
c      write(lun,20) 'cat ../input_app.txt >& input_app.txt'
 
461
c      write(lun,20) 'echo $i >> input_app.txt'
 
462
c      if (.false.) then
 
463
c         write(lun,20) 'cp ../../public.sh .'
 
464
c         write(lun,20) 'qsub -N $1$i public.sh >> ../../running_jobs'
 
465
c      else
 
466
c         write(lun,20) 'time ../madevent > $k <input_app.txt'
 
467
c         write(lun,20) 'rm -f ftn25 ftn99'
 
468
c         write(lun,20) 'cp $k log.txt'
 
469
c      endif
 
470
c      write(lun,20) 'cd ../'
 
471
c      write(lun,15) 'end'
 
472
 15   format(a)
 
473
 20   format(5x,a)
 
474
 25   format(10x,a)
 
475
      close(lun)
 
476
      end
 
477
 
 
478
 
 
479
 
 
480
      subroutine write_gen(goal_lum,ng,jpoints,gn,xlum,xtot,mfact,xsec)
 
481
c*****************************************************************************
 
482
c     Writes out scripts for achieving unweighted event goals
 
483
c*****************************************************************************
 
484
      implicit none
 
485
c
 
486
c     Constants
 
487
c
 
488
      include 'run_config.inc'
 
489
      integer   max_amps
 
490
      parameter (max_amps=9999)
 
491
c
 
492
c     global
 
493
c
 
494
      integer max_np
 
495
      common/max_np/max_np
 
496
c      integer    max_np     !now set in run_config.inc
 
497
c      parameter (max_np = 5)  !number of channels/job
 
498
 
 
499
c
 
500
c     Arguments
 
501
c
 
502
      double precision goal_lum, xlum(max_amps), xsec(max_amps),xtot
 
503
      integer jpoints(max_amps), mfact(max_amps)
 
504
      integer ng, np
 
505
      character*(80) gn(max_amps)
 
506
c
 
507
c     Local
 
508
c
 
509
      integer i,j,k, io(max_amps), npoints, ip, nfiles,ifile,npfile
 
510
      double precision xt(max_amps),elimit
 
511
      double precision yerr,ysec,rerr
 
512
      logical fopened
 
513
c-----
 
514
c  Begin Code
 
515
c-----
 
516
      fopened=.false.
 
517
      write(*,*) 'Working on creating ', goal_lum, ' events.'
 
518
      goal_lum = goal_lum/(xtot*1000) !Goal luminosity in fb^-1
 
519
      write(*,*) 'Effective Luminosity', goal_lum, ' fb^-1.'
 
520
      k=0
 
521
      do j=1,ng
 
522
         io(j) = j
 
523
         xt(j)= goal_lum/xlum(j)       !sort by events_needed/have.
 
524
         write(*,*) j,xlum(j),xt(j)
 
525
      enddo
 
526
c      write(*,*) 'Number of channels',ng,k
 
527
c
 
528
c     Let's redetermine err_goal based on luminosity
 
529
c
 
530
      elimit = 1d0
 
531
      call sort2(xt,io,ng)
 
532
      k=1
 
533
      xt(ng+1) = 0
 
534
      do while( xt(k) .gt. abs(elimit)) !elimit should be >0
 
535
         write(*,*) 'Improving ',k,gn(io(k)),xt(k)
 
536
         k=k+1
 
537
      enddo
 
538
      k=k-1
 
539
c      write(*,*) 'Number of diagrams to fix',k
 
540
c
 
541
c     Now readjust because most don't contribute
 
542
c
 
543
 
 
544
c      np = max_np
 
545
 
 
546
c
 
547
c     Want to write channels so that heaviest one (with largest error)
 
548
c     gets grouped with least heavy channels. Complicated ordering for this
 
549
c     follows. np is the present process number.
 
550
c
 
551
      nfiles = k/max_np
 
552
      if(mod(k,max_np).gt.0) nfiles=nfiles+1
 
553
      ifile  = 0
 
554
      npfile = 0
 
555
      np = 1
 
556
      
 
557
 
 
558
      do i=1,k
 
559
         yerr = xt(np)
 
560
         npoints=0.2*jpoints(io(np))*(yerr/elimit)
 
561
         npoints = max(npoints,min_events)
 
562
         npoints = min(npoints,max_events)
 
563
 
 
564
c         np = np + 5*npoints
 
565
         npfile=npfile+1
 
566
         np = nfiles*npfile+1-ifile
 
567
         if (np .gt. k .or. ifile.eq.0) then
 
568
            if (fopened) then
 
569
               write(26,15) 'rm -f run.$script >& /dev/null'
 
570
               write(26,15) 'touch done.$script >& /dev/null'
 
571
               close(26)
 
572
            endif
 
573
            fopened=.true.
 
574
            call open_bash_file(26)
 
575
c            np = 5*npoints
 
576
            ifile=ifile+1
 
577
            npfile=1
 
578
            np = ifile
 
579
         endif
 
580
         ip = index(gn(io(np)),'/')
 
581
         write(*,*) 'Channel ',gn(io(np))(2:ip-1),
 
582
     $        yerr, jpoints(io(np)),npoints
 
583
 
 
584
         ip = index(gn(io(np)),'/')
 
585
         write(26,'(2a)') 'j=',gn(io(np))(1:ip-1)
 
586
c
 
587
c     Now write the commands
 
588
c      
 
589
         write(26,20) 'echo $j'
 
590
         write(26,20) 'if [[ ! -e $j ]]; then'
 
591
         write(26,25) 'mkdir $j'
 
592
         write(26,20) 'fi'
 
593
         write(26,20) 'cd $j'
 
594
         write(26,20) 'rm -f $k'
 
595
c
 
596
c     Now I'll add a check to make sure the grid has been
 
597
c     adjusted  (ftn99 or ftn25 exist)
 
598
c
 
599
         write(26,20) 'if  [[ -e ftn26 ]]; then'
 
600
         write(26,25) 'cp ftn26 ftn25'
 
601
         write(26,20) 'fi'
 
602
 
 
603
         write(26,20) 'if [[ ! -e ftn25 ]]; then'
 
604
 
 
605
 
 
606
         write(26,'(9x,a,2i8,a)') 'echo "',npoints,max_iter,
 
607
     $        '" >& input_sg.txt' 
 
608
c
 
609
c     tjs 8/7/2007  Allow stop when have enough events
 
610
c
 
611
         write(*,*) "Cross section",i,io(np),xsec(io(np)),mfact(io(np))
 
612
         write(26,'(9x,a,f11.3,a)') 'echo "',-goal_lum*xsec(io(np))*1000,
 
613
     $        '" >> input_sg.txt'                       !Accuracy
 
614
         write(26,'(9x,a)') 'echo "2" >> input_sg.txt'  !Grid Adjustment
 
615
         write(26,'(9x,a)') 'echo "1" >> input_sg.txt'  !Suppression
 
616
         write(26,'(9x,a,i4,a)') 'echo "',nhel_refine,
 
617
     &        ' " >> input_sg.txt' !Helicity 0=exact
 
618
         write(26,'(9x,3a)')'echo "',gn(io(np))(2:ip-1),
 
619
     $        '" >>input_sg.txt'
 
620
         write(26,25) 'time ../madevent >> $k <input_sg.txt'
 
621
         write(26,25) 'cat $k >> log.txt'
 
622
         write(26,25) 'if [[ -e ftn26 ]]; then'
 
623
         write(26,25) '     cp ftn26 ftn25'
 
624
         write(26,25) 'fi'
 
625
         write(26,20) 'else'
 
626
 
 
627
         write(26,25) 'rm -f $k'
 
628
 
 
629
         write(26,'(9x,a,2i8,a)') 'echo "',npoints,max_iter,
 
630
     $        '" >& input_sg.txt' 
 
631
c
 
632
c tjs 8/7/2007    Change to request events not accuracy
 
633
c
 
634
         write(26,'(9x,a,f11.3,a)') 'echo "',-goal_lum*xsec(io(np))*1000,
 
635
     $        '" >> input_sg.txt'                       !Accuracy
 
636
c         write(26,'(9x,a,e12.3,a)') 'echo "',-goal_lum*mfact(io(np)),
 
637
c     $        '" >> input_sg.txt'
 
638
         write(26,'(9x,a)') 'echo "0" >> input_sg.txt'
 
639
         write(26,'(9x,a)') 'echo "1" >> input_sg.txt'
 
640
 
 
641
         write(26,'(9x,a,i4,a)') 'echo "',nhel_refine,
 
642
     &        ' " >> input_sg.txt' !Helicity 0=exact
 
643
 
 
644
         write(26,'(9x,3a)')'echo "',gn(io(np))(2:ip-1),
 
645
     $        '" >>input_sg.txt'
 
646
 
 
647
 
 
648
c         write(26,'(9x,a)') 'echo "1" >> input_sg.txt' !Helicity 0=exact
 
649
 
 
650
c         write(26,'(5x,3a)')'echo "',gn(io(np))(2:ip-1),
 
651
c     $        '" >>input_sg.txt'
 
652
c         write(26,20) 'cp ../../public_sg.sh .'
 
653
c         write(26,20) 'qsub -N $1$j public_sg.sh >> ../../running_jobs'
 
654
         write(26,25) 'if [[ -e ftn26 ]]; then'
 
655
         write(26,25) '     cp ftn26 ftn25'
 
656
         write(26,25) 'fi'
 
657
         write(26,25) 'time ../madevent >> $k <input_sg.txt'
 
658
         write(26,25) 'cat $k >> log.txt'
 
659
         write(26,20) 'fi'
 
660
         write(26,20) 'cd ../'
 
661
      enddo
 
662
      if (fopened) then
 
663
        write(26,15) 'rm -f run.$script'
 
664
        write(26,15) 'touch done.$script'
 
665
        close(26)
 
666
      endif
 
667
c      write(26,15) 'end'
 
668
 15   format(a)
 
669
 20   format(5x,a)
 
670
 25   format(10x,a)
 
671
 999  close(26)
 
672
      end
 
673
 
 
674
 
 
675
      subroutine write_gen_grid(goal_lum,ngran,ng,jpoints,gn,xlum,xtot,mfact,xsec)
 
676
c*****************************************************************************
 
677
c     Writes out scripts for achieving unweighted event goals
 
678
c*****************************************************************************
 
679
      implicit none
 
680
c
 
681
c     Constants
 
682
c
 
683
      include 'run_config.inc'
 
684
      integer   max_amps
 
685
      parameter (max_amps=9999)
 
686
c
 
687
c   global
 
688
c
 
689
      integer max_np
 
690
      common/max_np/max_np
 
691
c
 
692
c     Arguments
 
693
c
 
694
      double precision goal_lum, xlum(max_amps), xsec(max_amps),xtot
 
695
      double precision ngran   !Granularity.... min # points from channel
 
696
      integer jpoints(max_amps), mfact(max_amps)
 
697
      integer ng, np
 
698
      character*(80) gn(max_amps)
 
699
c
 
700
c     Local
 
701
c
 
702
      integer i,j,k, npoints, ip
 
703
      double precision xt(max_amps),elimit
 
704
      double precision yerr,ysec,rerr
 
705
      character*72 fname
 
706
      logical fopened
 
707
      double precision rvec
 
708
c-----
 
709
c  Begin Code
 
710
c-----
 
711
 
 
712
c      data ngran /10/
 
713
      fopened=.false.
 
714
c
 
715
c     These random #'s should be changed w/ run
 
716
c
 
717
c      ij=2134
 
718
c      kl = 4321
 
719
      rvec=0d0
 
720
      write(*,*) 'Working on creating ', goal_lum, ' events.'
 
721
      max_np = 1
 
722
      np = max_np   !Flag to open csh file
 
723
      do i=1,ng
 
724
         call ranmar(rvec)
 
725
         ip = index(gn(i),'/')
 
726
         fname = gn(i)(1:ip) // 'gscalefact.dat'
 
727
         open(unit=27,file=fname,status='unknown',err=91)
 
728
         if (goal_lum * xsec(i)/xtot  .ge. rvec*ngran ) then !need events
 
729
            write(*,*) 'Requesting events from ',gn(i)(1:ip-1),xsec(i),xtot/goal_lum
 
730
            if (xsec(i) .gt. xtot*ngran/goal_lum) then
 
731
               write(27,*) 1d0
 
732
            else
 
733
               write(27,*) xtot*ngran/xsec(i)/goal_lum
 
734
            endif
 
735
            npoints = goal_lum * xsec(i) / xtot
 
736
            if (npoints .lt. min_gevents_wu) npoints = min_gevents_wu
 
737
            np = np+1
 
738
            if (np .gt. max_np) then
 
739
               if (fopened) then
 
740
                  write(26,15) 'rm -f run.$script >& /dev/null'
 
741
                  write(26,15) 'touch done.$script >& /dev/null'
 
742
                  close(26)
 
743
               endif
 
744
               fopened=.true.
 
745
               call open_bash_file(26)
 
746
               np = 1
 
747
            endif
 
748
            ip = index(gn(i),'/')
 
749
            write(*,*) 'Channel ',gn(i)(2:ip-1),
 
750
     $           yerr, jpoints(i),npoints
 
751
 
 
752
            ip = index(gn(i),'/')
 
753
            write(26,'(2a)') 'j=',gn(i)(1:ip-1)
 
754
c
 
755
c           Now write the commands
 
756
c      
 
757
            write(26,20) 'echo $j'
 
758
            write(26,20) 'if [[ ! -e $j ]]; then'
 
759
            write(26,25) 'mkdir $j'
 
760
            write(26,20) 'fi'
 
761
            write(26,20) 'cd $j'
 
762
            write(26,20) 'rm -f $k'
 
763
c
 
764
c     Now I'll add a check to make sure the grid has been
 
765
c     adjusted  (ftn99 or ftn25 exist)
 
766
c
 
767
            write(26,20) 'if  [[ -e ftn26 ]]; then'
 
768
            write(26,25) 'cp ftn26 ftn25'
 
769
            write(26,20) 'fi'
 
770
 
 
771
            write(26,20) 'if [[ ! -e ftn25 ]]; then'
 
772
 
 
773
 
 
774
            write(26,'(9x,a,2i8,a)') 'echo "',npoints,max_iter,
 
775
     $           '" >& input_sg.txt' 
 
776
c
 
777
c     tjs 8/7/2007  Allow stop when have enough events
 
778
c
 
779
            write(*,*) "Cross section",i,xsec(i),mfact(i)
 
780
            write(26,'(9x,a,f11.3,a)') 'echo "',-npoints*1.2,
 
781
     $        '" >> input_sg.txt'                       !Accuracy
 
782
            write(26,'(9x,a)') 'echo "2" >> input_sg.txt' !Grid Adjustment
 
783
            write(26,'(9x,a)') 'echo "1" >> input_sg.txt' !Suppression
 
784
            write(26,'(9x,a,i4,a)') 'echo "',nhel_refine,
 
785
     &           ' " >> input_sg.txt' !Helicity 0=exact
 
786
            write(26,'(9x,3a)')'echo "',gn(i)(2:ip-1),
 
787
     $           '" >>input_sg.txt'
 
788
            write(26,25) 'time ../madevent >> $k <input_sg.txt'
 
789
            write(26,25) 'cat $k >> log.txt'
 
790
            write(26,25) 'if [[ -e ftn26 ]]; then'
 
791
            write(26,25) '     cp ftn26 ftn25'
 
792
            write(26,25) 'fi'
 
793
            write(26,20) 'else'
 
794
 
 
795
            write(26,25) 'rm -f $k'
 
796
            
 
797
            write(26,'(9x,a,2i8,a)') 'echo "',npoints,max_iter,
 
798
     $           '" >& input_sg.txt' 
 
799
c
 
800
c tjs 8/7/2007    Change to request events not accuracy
 
801
c
 
802
            write(26,'(9x,a,f11.3,a)') 'echo "',-npoints*1.2,
 
803
     $           '" >> input_sg.txt' !Accuracy
 
804
            write(26,'(9x,a)') 'echo "0" >> input_sg.txt'
 
805
            write(26,'(9x,a)') 'echo "1" >> input_sg.txt'
 
806
 
 
807
            write(26,'(9x,a,i4,a)') 'echo "',nhel_refine,
 
808
     &           ' " >> input_sg.txt' !Helicity 0=exact
 
809
 
 
810
            write(26,'(9x,3a)')'echo "',gn(i)(2:ip-1),
 
811
     $           '" >>input_sg.txt'
 
812
 
 
813
            write(26,25) 'if [[ -e ftn26 ]]; then'
 
814
            write(26,25) '     cp ftn26 ftn25'
 
815
            write(26,25) 'fi'
 
816
            write(26,25) 'time ../madevent >> $k <input_sg.txt'
 
817
            write(26,25) 'cat $k >> log.txt'
 
818
            write(26,20) 'fi'
 
819
            write(26,20) 'cd ../'
 
820
         else    !No events from this channel
 
821
            write(*,*) 'Skipping channel:',gn(i)(1:ip-1),xsec(i)*goal_lum/xtot,rvec
 
822
            write(27,*) 0d0
 
823
         endif
 
824
         close(27)
 
825
 91      cycle
 
826
      enddo
 
827
      write(26,15) 'rm -f run.$script'
 
828
      write(26,15) 'touch done.$script'
 
829
      close(26)
 
830
 15   format(a)
 
831
 20   format(5x,a)
 
832
 25   format(10x,a)
 
833
 999  close(26)
 
834
      close(27)
 
835
      end
 
836
 
 
837
 
 
838
      subroutine sort2(array,aux1,n)
 
839
      implicit none
 
840
! Arguments
 
841
      integer n
 
842
      integer aux1(n)
 
843
      double precision array(n)
 
844
!  Local Variables
 
845
      integer i,k
 
846
      double precision temp
 
847
      logical done
 
848
 
 
849
!-----------
 
850
! Begin Code
 
851
!-----------
 
852
      do i=n-1,1,-1
 
853
         done = .true.
 
854
         do k=1,i
 
855
            if (array(k) .lt. array(k+1)) then
 
856
               temp = array(k)
 
857
               array(k) = array(k+1)
 
858
               array(k+1) = temp
 
859
               temp = aux1(k)
 
860
               aux1(k) = aux1(k+1)
 
861
               aux1(k+1) = temp
 
862
               done = .false.
 
863
            end if
 
864
         end do
 
865
         if (done) return
 
866
      end do
 
867
      end 
 
868
 
 
869
 
 
870
      subroutine get_xsec_log(xsec,xerr,eff,xmax)
 
871
c*********************************************************************
 
872
c     Reads from output file, gets cross section and maxwgt from
 
873
c     first two iterations
 
874
c*********************************************************************
 
875
      implicit none
 
876
c
 
877
c     Arguments
 
878
c
 
879
      double precision xsec(2),xerr(2),eff(2),xmax(2)
 
880
c
 
881
c     Local
 
882
c     
 
883
      character*78 buff
 
884
      integer i
 
885
c-----
 
886
c  Begin Code
 
887
c-----
 
888
      xsec(1) = 0d0
 
889
      xerr(1) = 0d0
 
890
      xmax(1) = 0d0
 
891
      do while (.true.)
 
892
         read(25,'(a80)',err=99) buff
 
893
         if (buff(1:4) .eq. 'Iter') then
 
894
            read(buff(11:16),'(i5)') i
 
895
            if (i .eq. 1 .or. i .eq. 2) then
 
896
               read(buff(61:70),*) xmax(i)
 
897
               read(buff(21:33),*) xsec(i)
 
898
               xmax(i)=xmax(i)/xsec(i)
 
899
c               read(buff(48:59),*) xerr(i)
 
900
c               read(buff(48:59),*) xmax(i)
 
901
            endif
 
902
            read(25,'(a80)',err=99) buff
 
903
            read(buff(1:6),'(i5)') i
 
904
            if (i .eq. 1 .or. i .eq. 2) then
 
905
               read(buff(6:17),*) xsec(i)
 
906
               read(buff(20:31),*) xerr(i)
 
907
               read(buff(34:40),*) eff(i)               
 
908
            endif
 
909
            write(*,'(i4,4f12.3)') i,xsec(i),xerr(i),eff(i),xmax(i)
 
910
         endif
 
911
      enddo
 
912
 99   end
 
913
 
 
914
 
 
915
 
 
916