C++InterfacetoTauola
combine.f
1  PROGRAM main
2 C ***********************************
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 
64 C ------------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(' ')
75 C ------------THE END OF HISTO WRITING -------------------------
76  CLOSE(nout)
77 C ***********
78  END
79