FV3DYCORE  Version 1.1.0
fv_timing.F90
Go to the documentation of this file.
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the FV3 dynamical core.
5 !*
6 !* The FV3 dynamical core is free software: you can redistribute it
7 !* and/or modify it under the terms of the
8 !* GNU Lesser General Public License as published by the
9 !* Free Software Foundation, either version 3 of the License, or
10 !* (at your option) any later version.
11 !*
12 !* The FV3 dynamical core is distributed in the hope that it will be
13 !* useful, but WITHOUT ANYWARRANTY; without even the implied warranty
14 !* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15 !* See the GNU General Public License for more details.
16 !*
17 !* You should have received a copy of the GNU Lesser General Public
18 !* License along with the FV3 dynamical core.
19 !* If not, see <http://www.gnu.org/licenses/>.
20 !***********************************************************************
21 
23 
25 
26 ! <table>
27 ! <tr>
28 ! <th>Module Name</th>
29 ! <th>Functions Included</th>
30 ! </tr>
31 ! <td>fv_mp_mod</td>
32 ! <td>is_master, mp_reduce_max</td>
33 ! </tr>
34 ! <tr>
35 ! <td>mpp_mod</td>
36 ! <td>mpp_error, FATAL</td>
37 ! </tr>
38 ! </table>
39 
40  use mpp_mod, only: mpp_error, fatal
41 #if defined(SPMD)
42  use fv_mp_mod, only: is_master, mp_reduce_max
43 #endif
44 !
45 ! ... Use system etime() function for timing
46 !
47  implicit none
48 
49  integer, private :: nblks
50  parameter(nblks = 100)
51 
52  character(len=20), private :: blkname(nblks)
53 
54  integer , private :: tblk
55 
56 #if defined(SPMD)
57  real(kind=8) , external :: mpi_wtime
58 #endif
59  real , private :: etime
60  real(kind=8) , private :: totim
61  real , private :: tarray(2)
62  type tms
63  private
64  real (kind=8) :: usr, sys
65  end type tms
66 
67 
68  type(tms), private :: accum(nblks), last(nblks)
69 
70  real , private :: us_tmp1(nblks,2)
71  real , private :: us_tmp2(nblks,2)
72 
73  logical, private :: module_initialized = .false.
74 
75  contains
76 
78  subroutine timing_init
79  implicit none
80 
81  integer :: C, R, M
82  real (kind=8) :: wclk
83 
84  integer n
85 
86  if ( module_initialized ) return
87 
88  tblk=0
89  do n = 1, nblks
90  accum(n)%usr = 0.
91  accum(n)%sys = 0.
92  last(n)%usr = 0.
93  last(n)%sys = 0.
94  end do
95 !
96 ! ... To reduce the overhead for the first call
97 !
98 #if defined(SPMD)
99  wclk = mpi_wtime()
100  totim = wclk
101 #else
102 # if defined( IRIX64 ) || ( defined FFC )
103  totim = etime(tarray)
104 # else
105  CALL system_clock(count=c, count_rate=r, count_max=m)
106  wclk = REAL(C) / REAL(r)
107  totim = wclk
108 # endif
109 #endif
110 
111  module_initialized = .true.
112  end subroutine timing_init
113 
115  subroutine timing_on(blk_name)
116  implicit none
117 
118  character(len=*) :: blk_name
119 
120 
121 
122  character(len=20) :: UC_blk_name
123  character(len=20) :: ctmp
124  integer i
125  integer iblk
126 
127  integer :: C, R, M
128  real (kind=8) :: wclk
129 
130  integer ierr
131 
132  if ( .not. module_initialized ) then
133  call timing_init()
134  end if
135 
136  uc_blk_name = blk_name
137 
138  call upper(uc_blk_name,len_trim(uc_blk_name))
139 !c ctmp=UC_blk_name(:len_trim(UC_blk_name))
140  ctmp=trim(uc_blk_name)
141 
142 ! write(*,*) 'timing_on ', ctmp
143  iblk=0
144  do i=1, tblk
145  if ( ctmp .EQ. blkname(i) ) then
146  iblk =i
147  endif
148  enddo
149 
150  if ( iblk .eq. 0 ) then
151  tblk=tblk+1
152  iblk=tblk
153  call upper(uc_blk_name,len_trim(uc_blk_name))
154 !C blkname(iblk)=UC_blk_name(:len_trim(UC_blk_name))
155  blkname(iblk)=trim(uc_blk_name)
156 
157  endif
158 
159 #if defined(SPMD)
160  wclk = mpi_wtime()
161  last(iblk)%usr = wclk
162  last(iblk)%sys = 0.0
163 #else
164 # if defined( IRIX64 ) || ( defined FFC )
165  totim = etime(tarray)
166  last(iblk)%usr = tarray(1)
167  last(iblk)%sys = tarray(2)
168 # else
169  CALL system_clock(count=c, count_rate=r, count_max=m)
170  wclk = REAL(C) / REAL(r)
171  last(iblk)%usr = wclk
172  last(iblk)%sys = 0.0
173 # endif
174 #endif
175 
176  end subroutine timing_on
177 
179  subroutine timing_off(blk_name)
180  implicit none
181  character(len=*) :: blk_name
182 
183  character(len=20) :: UC_blk_name
184  character(len=20) :: ctmp
185  integer i
186 
187  integer :: C, R, M
188  real (kind=8) :: wclk
189 
190  integer iblk
191 
192  uc_blk_name = blk_name
193 
194  call upper(uc_blk_name,len_trim(uc_blk_name))
195 !v ctmp=UC_blk_name(:len_trim(UC_blk_name))
196  ctmp=trim(uc_blk_name)
197 
198  iblk=0
199  do i=1, tblk
200  if ( ctmp .EQ. blkname(i) ) then
201  iblk =i
202  endif
203  enddo
204 
205 ! write(*,*) 'timing_off ', ctmp, tblk, tblk
206  if ( iblk .eq. 0 ) then
207  call mpp_error(fatal,'fv_timing_mod: timing_off called before timing_on for: '//trim(blk_name))
208 ! write(*,*) 'stop in timing off in ', ctmp
209 ! stop
210  endif
211 
212 #if defined(SPMD)
213  wclk = mpi_wtime()
214  accum(iblk)%usr = accum(iblk)%usr + wclk - last(iblk)%usr
215  accum(iblk)%sys = 0.0
216  last(iblk)%usr = wclk
217  last(iblk)%sys = 0.0
218 #else
219 # if defined( IRIX64 ) || ( defined FFC )
220  totim = etime(tarray)
221  accum(iblk)%usr = accum(iblk)%usr + &
222  tarray(1) - last(iblk)%usr
223  accum(iblk)%sys = accum(iblk)%sys + &
224  tarray(2) - last(iblk)%sys
225  last(iblk)%usr = tarray(1)
226  last(iblk)%sys = tarray(2)
227 # else
228  CALL system_clock(count=c, count_rate=r, count_max=m)
229  wclk = REAL(C) / REAL(r)
230  accum(iblk)%usr = accum(iblk)%usr + wclk - last(iblk)%usr
231  accum(iblk)%sys = 0.0
232  last(iblk)%usr = wclk
233  last(iblk)%sys = 0.0
234 # endif
235 #endif
236  end subroutine timing_off
237 
239  subroutine timing_clear()
240  integer n
241  do n = 1, nblks
242  accum(n)%usr = 0
243  accum(n)%sys = 0
244  enddo
245  end subroutine timing_clear
246 
248  subroutine timing_prt(gid)
249  implicit none
250  integer gid
251  integer n
252 
253  type(tms) :: others, tmp(nblks)
254  real :: tmpmax
255 
256 #if defined( SPMD )
257  do n = 1, nblks !will clean these later
258  tmpmax = accum(n)%usr
259  call mp_reduce_max(tmpmax)
260  tmp(n)%usr = tmpmax
261  tmpmax = accum(n)%sys
262  call mp_reduce_max(tmpmax)
263  tmp(n)%sys = tmpmax
264  enddo
265  if ( is_master() ) then
266 #else
267  do n = 1, nblks
268  tmp(n)%usr = accum(n)%usr
269  tmp(n)%sys = accum(n)%sys
270  enddo
271 #endif
272 
273  print *
274  print *, &
275  ' -----------------------------------------------------'
276  print *, &
277  ' Block User time System Time Total Time GID '
278  print *, &
279  ' -----------------------------------------------------'
280 
281  do n = 1, tblk
282  print '(3x,a20,2x,3(1x,f12.4), 2x, I6)', blkname(n), &
283  tmp(n)%usr, tmp(n)%sys, tmp(n)%usr + tmp(n)%sys, gid
284  end do
285 
286 
287  print *
288 #if defined( SPMD )
289  endif ! masterproc
290 #endif
291 
292  end subroutine timing_prt
293 
294  subroutine upper(string,length)
296 !***********************************************************************
297 !
298 ! upper.f - change lower case letter to upper case letter *
299 ! *
300 ! George Lai Tue Jun 28 16:37:00 1994 *
301 ! *
302 !***********************************************************************
303 
304  implicit none
305 
306 ! character string(length)
307 ! character(len=20) string
308 ! character, dimension(length) :: string
309 ! character (len=*), intent(inout) :: string
310 ! character (len=*) :: string
311 ! character (len=1), intent(inout) :: string(20)
312 !ok character (len=20), intent(inout) :: string
313  character (len=*), intent(inout) :: string
314  character char1
315  integer, intent(in) :: length
316  integer i
317  integer a, z, dist
318  a = ichar('a')
319  z = ichar('z')
320  dist = ichar('A') - a
321 
322  do i = 1,length
323  char1=string(i:i)
324  if (ichar(char1) .ge. a .and. &
325  ichar(char1) .le. z) then
326  string(i:i) = char(ichar(char1)+dist)
327  endif
328  end do
329 
330  return
331  end subroutine upper
332 
333  end module fv_timing_mod
The module &#39;fv_mp_mod&#39; is a single program multiple data (SPMD) parallel decompostion/communication m...
Definition: fv_mp_mod.F90:24
subroutine timing_off(blk_name)
The subroutine &#39;timing_off&#39; stops a timer.
Definition: fv_timing.F90:180
type(tms), dimension(nblks), private last
Definition: fv_timing.F90:68
integer, private nblks
Definition: fv_timing.F90:49
real, dimension(nblks, 2), private us_tmp2
Definition: fv_timing.F90:71
integer, private tblk
Definition: fv_timing.F90:54
real(kind=8), private totim
Definition: fv_timing.F90:60
real, dimension(nblks, 2), private us_tmp1
Definition: fv_timing.F90:70
real, dimension(2), private tarray
Definition: fv_timing.F90:61
The module &#39;fv_timing&#39; contains FV3 timers.
Definition: fv_timing.F90:24
character(len=20), dimension(nblks), private blkname
Definition: fv_timing.F90:52
subroutine timing_clear()
The subroutine &#39;timing_clear&#39; resets a timer.
Definition: fv_timing.F90:240
logical, private module_initialized
Definition: fv_timing.F90:73
subroutine upper(string, length)
Definition: fv_timing.F90:295
real, private etime
Definition: fv_timing.F90:59
subroutine timing_on(blk_name)
The subroutine &#39;timing_on&#39; starts a timer.
Definition: fv_timing.F90:116
subroutine timing_prt(gid)
The subroutine &#39;timing_prt&#39; prints all timers.
Definition: fv_timing.F90:249
subroutine timing_init
The subroutine &#39;timing_init&#39; initializes timers.
Definition: fv_timing.F90:79
type(tms), dimension(nblks), private accum
Definition: fv_timing.F90:68