C++ Interface to Tauola
tauola-fortran
glibk
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
Generated by
1.9.6