1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
subroutine timer(dname,k)
! Times procedure number n between a call with k=0 (tstart) and with
! k=1 (tstop). Accumulates sums of these times in array ut (user time).
! Also traces all calls (for debugging purposes) if limtrace.gt.0
character*8 dname,name(50),space,ename
character*16 sname
logical on(50)
real ut(50),ut0(50),dut(50)
integer ncall(50),nlevel(50),nparent(50)
integer onlevel(0:10)
common/tracer/ limtrace,lu
data eps/0.000001/,ntrace/0/
data level/0/,nmax/0/,space/' '/
data limtrace/0/,lu/-1/
save
if(limtrace.lt.0) go to 999
if(lu.lt.1) lu=6
if(k.gt.1) go to 40 !Check for "all done" (k>1)
onlevel(0)=0
do n=1,nmax !Check for existing name
if(name(n).eq.dname) go to 20
enddo
nmax=nmax+1 !This is a new one
n=nmax
ncall(n)=0
on(n)=.false.
ut(n)=eps
name(n)=dname
20 if(k.eq.0) then !Get start times (k=0)
if(on(n)) print*,'Error in timer: ',dname,' already on.'
level=level+1 !Increment the level
on(n)=.true.
call system_clock(icount,irate)
ut0(n)=float(icount)/irate
ncall(n)=ncall(n)+1
if(ncall(n).gt.1.and.nlevel(n).ne.level) then
nlevel(n)=-1
else
nlevel(n)=level
endif
nparent(n)=onlevel(level-1)
onlevel(level)=n
else if(k.eq.1) then !Get stop times and accumulate sums. (k=1)
if(on(n)) then
on(n)=.false.
call system_clock(icount,irate)
ut1=float(icount)/irate
ut(n)=ut(n)+ut1-ut0(n)
endif
level=level-1
endif
ntrace=ntrace+1
if(ntrace.lt.limtrace) write(lu,1020) ntrace,dname,k,level,nparent(n)
1020 format(i8,': ',a8,3i5)
go to 998
! Write out the timer statistics
40 write(lu,1040)
1040 format(/' name time frac dtime', &
' dfrac calls level parent'/73('-'))
if(k.gt.100) then
ndiv=k-100
do i=1,nmax
ncall(i)=ncall(i)/ndiv
ut(i)=ut(i)/ndiv
enddo
endif
total=ut(1)
sum=0.
sumf=0.
do i=1,nmax
dut(i)=ut(i)
do j=i,nmax
if(nparent(j).eq.i) dut(i)=dut(i)-ut(j)
enddo
utf=ut(i)/total
dutf=dut(i)/total
sum=sum+dut(i)
sumf=sumf+dutf
kk=nlevel(i)
sname=space(1:kk)//name(i)//space(1:8-kk)
ename=space
if(i.ge.2) ename=name(nparent(i))
write(lu,1060) float(i),sname,ut(i),utf,dut(i),dutf, &
ncall(i),nlevel(i),ename
1060 format(f4.0,a16,2(f10.2,f6.2),i7,i5,2x,a8)
enddo
write(lu,1070) sum,sumf
1070 format(/36x,f10.2,f6.2)
nmax=0
eps=0.000001
ntrace=0
level=0
space=' '
onlevel(0)=0
998 flush(lu)
999 return
end subroutine timer
|
