!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! GNU General Public License !! !! !! !! This file is part of the Flexible Modeling System (FMS). !! !! !! !! FMS is free software; you can redistribute it and/or modify !! !! it and are expected to follow the terms of the GNU General Public !! !! License as published by the Free Software Foundation. !! !! !! !! FMS is distributed in the hope that it will be useful, !! !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! !! GNU General Public License for more details. !! !! !! !! You should have received a copy of the GNU General Public License !! !! along with FMS; if not, write to: !! !! Free Software Foundation, Inc. !! !! 59 Temple Place, Suite 330 !! !! Boston, MA 02111-1307 USA !! !! or see: !! !! http://www.gnu.org/licenses/gpl.txt !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module timingModule use shr_kind_mod, only : r8 => shr_kind_r8, r4 => shr_kind_r4, & i8 => shr_kind_i8, i4 => shr_kind_i4 implicit none ! ! ... Use system etime() function for timing ! #if defined( CRAY ) || defined( CRAY_T3E ) #define CPP_REAL r8 #define CPP_INT i8 #else #define CPP_REAL r4 #define CPP_INT i4 #endif #if defined(USE_VT) #include "VT.inc" integer :: vterr #endif integer, private :: nblks parameter (nblks = 100) character*20, private :: blkname(nblks) #if defined(USE_VT) integer, private :: vt_blks(nblks) #endif integer (CPP_INT), private :: tblk real (CPP_REAL), private :: etime real (CPP_REAL), private :: totim real (CPP_REAL), private :: tarray(2) type tms private real (CPP_REAL) :: usr, sys end type tms type (tms), private :: accum(nblks), last(nblks) real (CPP_REAL), private :: us_tmp1(nblks,2) real (CPP_REAL), private :: us_tmp2(nblks,2) contains #ifdef TIMING subroutine timing_init # if defined( CRAY ) || defined( CRAY_T3E ) real (CPP_REAL) :: real8c, real8r # endif integer (CPP_INT) :: C, R, M real (CPP_REAL) :: wclk integer n tblk=0 do n = 1, nblks accum(n)%usr = 0. accum(n)%sys = 0. last(n)%usr = 0. last(n)%sys = 0. end do ! ! ... To reduce the overhead for the first call ! # if defined( IRIX64 ) || ( defined FFC ) totim = etime(tarray) # else CALL SYSTEM_CLOCK(Count=C, Count_Rate=R, Count_Max=M) # if defined( CRAY ) || defined( CRAY_T3E ) real8c = C real8r = R wclk = real8c / real8r totim = wclk # else wclk = REAL(C) / REAL(R) totim = wclk # endif # endif end subroutine timing_init subroutine timing_on(blk_name) ! ! timing_on ! character*(*) blk_name character*20 UC_blk_name character*20 ctmp integer i integer iblk # if defined( CRAY ) || defined( CRAY_T3E ) real (CPP_REAL) :: real8c, real8r # endif integer (CPP_INT) :: C, R, M real (CPP_REAL) :: wclk integer ierr UC_blk_name = blk_name call upper(UC_blk_name,len_trim(UC_blk_name)) !c ctmp=UC_blk_name(:len_trim(UC_blk_name)) ctmp=trim(UC_blk_name) ! write(*,*) 'timing_on ', ctmp iblk=0 do i=1, tblk if ( ctmp .EQ. blkname(i) ) then iblk =i endif enddo if ( iblk .eq. 0 ) then tblk=tblk+1 iblk=tblk call upper(UC_blk_name,len_trim(UC_blk_name)) !C blkname(iblk)=UC_blk_name(:len_trim(UC_blk_name)) blkname(iblk)=trim(UC_blk_name) #if defined(USE_VT) vt_blks(iblk)=200+iblk call VTsymdef( vt_blks(iblk), blkname(iblk), blkname(iblk), vterr) #endif endif #if defined(USE_VT) call VTbegin(vt_blks(iblk), vterr) #endif # if defined( IRIX64 ) || ( defined FFC ) totim = etime(tarray) last(iblk)%usr = tarray(1) last(iblk)%sys = tarray(2) # else CALL SYSTEM_CLOCK(Count=C, Count_Rate=R, Count_Max=M) # if defined( CRAY ) || defined( CRAY_T3E ) real8c = C real8r = R wclk = real8c / real8r # else wclk = REAL(C) / REAL(R) # endif last(iblk)%usr = wclk last(iblk)%sys = 0.0 # endif end subroutine timing_on subroutine timing_off(blk_name) ! ! Timing_off ! character*(*) blk_name character*20 UC_blk_name character*20 ctmp integer i # if defined( CRAY ) || defined( CRAY_T3E ) real (CPP_REAL) :: real8c, real8r # endif integer (CPP_INT) :: C, R, M real (CPP_REAL) :: wclk integer iblk UC_blk_name = blk_name call upper(UC_blk_name,len_trim(UC_blk_name)) !v ctmp=UC_blk_name(:len_trim(UC_blk_name)) ctmp=trim(UC_blk_name) iblk=0 do i=1, tblk if ( ctmp .EQ. blkname(i) ) then iblk =i endif enddo ! write(*,*) 'timing_off ', ctmp, tblk, tblk if ( iblk .eq. 0 ) then ! write(*,*) 'stop in timing off in ', ctmp ! stop endif #if defined(USE_VT) call VTend(vt_blks(iblk), vterr) #endif # if defined( IRIX64 ) || ( defined FFC ) totim = etime(tarray) accum(iblk)%usr = accum(iblk)%usr + & tarray(1) - last(iblk)%usr accum(iblk)%sys = accum(iblk)%sys + & tarray(2) - last(iblk)%sys last(iblk)%usr = tarray(1) last(iblk)%sys = tarray(2) # else CALL SYSTEM_CLOCK(Count=C, Count_Rate=R, Count_Max=M) # if defined( CRAY ) || defined( CRAY_T3E ) real8c = C real8r = R wclk = real8c / real8r # else wclk = REAL(C) / REAL(R) # endif accum(iblk)%usr = accum(iblk)%usr + wclk - last(iblk)%usr accum(iblk)%sys = 0.0 last(iblk)%usr = wclk last(iblk)%sys = 0.0 # endif end subroutine timing_off subroutine timing_prt(gid) ! ! Timing_prt ! integer gid integer n type (tms) :: others, tmp(nblks) real :: tmpmax(1) #if defined( SPMD ) do n = 1, nblks !will clean these later tmpmax(1) = accum(n)%usr call getmax(1, tmpmax(1)) tmp(n)%usr = tmpmax(1) tmpmax(1) = accum(n)%sys call getmax(1, tmpmax(1)) tmp(n)%sys = tmpmax(1) enddo if ( gid .eq. 0 ) then #else do n = 1, nblks tmp(n)%usr = accum(n)%usr tmp(n)%sys = accum(n)%sys enddo #endif print * print *, & ' -------------------------------------------------------------' print *, & ' Block User time System Time Total Time' print *, & ' -------------------------------------------------------------' do n = 1, tblk print '(3x,a20,2x,3(1x,f12.4))', blkname(n), & tmp(n)%usr, tmp(n)%sys, tmp(n)%usr + tmp(n)%sys end do print * #if defined( SPMD ) print * endif #endif end subroutine timing_prt !endif of (defined TIMING) #else subroutine timing_init end subroutine timing_init subroutine timing_on(blk_name) character*(*) blk_name end subroutine timing_on subroutine timing_off(blk_name) character*(*) blk_name end subroutine timing_off subroutine timing_prt(gid) integer gid end subroutine timing_prt #endif end module TimingModule