mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-09-12 08:16:39 -04:00
e791efb5b8
This tries to account for function calls in different threads separately by decorating the function name with the thread number it is running in. This may not be the best strategy for performance timing but it is the easiest way of making it thread safe that I can see. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@4924 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
138 lines
3.5 KiB
Fortran
138 lines
3.5 KiB
Fortran
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
|
|
|
|
!$ interface
|
|
!$ integer function omp_get_thread_num()
|
|
!$ end function
|
|
!$ end interface
|
|
|
|
character*8 dname
|
|
!$ character thread
|
|
character*11 tname,ename
|
|
character*16 sname
|
|
character*11, save :: space
|
|
integer, save :: level, nmax
|
|
character*11, save :: name(50)
|
|
logical, save :: on(50)
|
|
real, save :: ut(50),ut0(50),dut(50)
|
|
integer, save :: ncall(50),nlevel(50),nparent(50)
|
|
integer, save :: onlevel(0:10)
|
|
common/tracer/ limtrace,lu
|
|
data eps/0.000001/,ntrace/0/
|
|
data level/0/,nmax/0/,space/' '/
|
|
data limtrace/0/,lu/-1/
|
|
!$omp threadprivate(level,space,onlevel)
|
|
|
|
tname=dname
|
|
!$ write(thread,'(i1)') omp_get_thread_num()
|
|
!$ tname=trim(dname)//'('//thread//')' ! decorate name with thread number
|
|
|
|
!$omp critical(timer)
|
|
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.tname) 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)=tname
|
|
|
|
20 if(k.eq.0) then !Get start times (k=0)
|
|
if(on(n)) print*,'Error in timer: ',tname,' already on.'
|
|
level=level+1 !Increment the level
|
|
on(n)=.true.
|
|
! call system_clock(icount,irate)
|
|
! ut0(n)=float(icount)/irate
|
|
! call cpu_time(ut0(n))
|
|
ut0(n)=secnds(0.0)
|
|
|
|
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
|
|
! call cpu_time(ut1)
|
|
ut1=secnds(0.0)
|
|
|
|
ut(n)=ut(n)+ut1-ut0(n)
|
|
endif
|
|
level=level-1
|
|
endif
|
|
|
|
ntrace=ntrace+1
|
|
if(ntrace.lt.limtrace) write(lu,1020) ntrace,tname,k,level,nparent(n)
|
|
1020 format(i8,': ',a11,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
|
|
if(dut(i).lt.0.0) dut(i)=0.0
|
|
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:11-kk)
|
|
ename=space
|
|
if(nparent(i).ge.1) 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.3,f6.2),i7,i5,2x,a11)
|
|
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 continue
|
|
|
|
!$omp end critical(timer)
|
|
return
|
|
end subroutine timer
|