C++ Interface to Tauola
combine.f
1 PROGRAM main
2C ***********************************
3 IMPLICIT DOUBLE PRECISION (a-h,o-z)
4 COMMON / inout / ninp,nout
5 dimension x(400),er(100)
6 CHARACTER*20 typop,file1,file2,file3,stop,merge
7 DATA stop /'stop'/
8 DATA merge /'merge'/
9
10 write(6,*) '>>>---------------------------------------<<<'
11 write(6,*) '>>> Welcome to COMBINE <<<'
12 write(6,*) '>>> Program for adding histogram files <<<'
13 write(6,*) '>>>---------------------------------------<<<'
14 CALL glk_initialize
15 ninp= 5
16 nout= 16
17 OPEN( nout, file='combine.out')
18 CALL glk_setnout(nout)
19
20! Get target file name
21 write(6,*) '>>> Give name of the TARGET file'
22 read(5,'(a)') file3
23! Get type of operation
24 write(6,*) '>>> add or merge?'
25 read(5,'(a)') typop
26! Get total number of histos
27 write(6,*) '>>> Give total number of histos'
28 read(5,*) ntot
29!
30! Restore first histogram
31 write(6,*) '>>> Give name of the FIRST histogram file on the disk'
32 read(5,'(a)') file1
33 ninph=0
34!*******************************************
35 OPEN(10+ninph,file=file1)
36!*******************************************
37 write(6,*) '>>> restoring:: ', file1
38 CALL glk_hrfile(10+ninph,' ',' ')
39 CALL glk_hrin( 0,9999,0)
40
41
42 600 CONTINUE
43! Restore second histogram and ADD to first
44 write(6,*) '>>> Give name of the NEXT histogram or type stop'
45 read(5,'(a)') file2
46 ninph=ninph+1
47 IF(file2 .EQ. stop) GOTO 900
48 IF(ninph .EQ. ntot) GOTO 900
49!*******************************************
50 OPEN(10+ninph,file=file2)
51!*******************************************
52 CALL glk_hrfile(10+ninph,' ',' ')
53 IF(typop .EQ. merge) THEN
54! Identical histos APPEND with id=>id+1000000
55 write(6,*) '>>> appending:: ', file2
56 CALL glk_hrin( 0,9999,0)
57 ELSE
58! Identical histos ADD directly
59 write(6,*) '>>> adding:: ', file2
60 CALL glk_hrin2( 0,9999,0)
61 ENDIF
62 GOTO 600
63
64C ------------dumping histogram --------------------------------
65 900 CONTINUE
66 write(6,*) '>>> Dumping result into:: ',file3
67 nouth=7
68!*******************************************
69 OPEN(nouth,file=file3)
70 rewind(nouth)
71!*******************************************
72 CALL glk_hrfile(nouth,' ','N')
73 CALL glk_hrout( 0,icy,' ')
74 CALL glk_hrend(' ')
75C ------------THE END OF HISTO WRITING -------------------------
76 CLOSE(nout)
77C ***********
78 END
79