New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
timers.f90 in branches/UKMO/dev_r5518_GO6_lock_test/NEMOGCM/TOOLS/WEIGHTS/src – NEMO

source: branches/UKMO/dev_r5518_GO6_lock_test/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90 @ 8452

Last change on this file since 8452 was 8452, checked in by frrh, 7 years ago

Lock files

File size: 10.5 KB
Line 
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!
3!     This module uses F90 cpu time routines to allowing setting of
4!     multiple CPU timers.
5!
6!-----------------------------------------------------------------------
7!
8!     CVS:$Id$
9!
10!     Copyright (c) 1997, 1998 the Regents of the University of
11!       California.
12!
13!     This software and ancillary information (herein called software)
14!     called SCRIP is made available under the terms described here. 
15!     The software has been approved for release with associated
16!     LA-CC Number 98-45.
17!
18!
19!     Unless otherwise indicated, this software has been authored
20!     by an employee or employees of the University of California,
21!     operator of the Los Alamos National Laboratory under Contract
22!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
23!     Government has rights to use, reproduce, and distribute this
24!     software.  The public may copy and use this software without
25!     charge, provided that this Notice and any statement of authorship
26!     are reproduced on all copies.  Neither the Government nor the
27!     University makes any warranty, express or implied, or assumes
28!     any liability or responsibility for the use of this software.
29!
30!     If software is modified to produce derivative works, such modified
31!     software should be clearly marked, so as not to confuse it with
32!     the version available from Los Alamos National Laboratory.
33!
34!***********************************************************************
35
36      module timers
37
38!-----------------------------------------------------------------------
39
40      use kinds_mod
41
42      implicit none
43
44      integer (kind=int_kind), parameter ::   &
45           max_timers = 99  ! max number of timers allowed
46
47      integer (kind=int_kind), save ::  &
48           cycles_max       ! max value of clock allowed by system
49
50      integer (kind=int_kind), dimension(max_timers), save ::  &
51           cycles1,          & ! cycle number at start for each timer
52           cycles2          ! cycle number at stop  for each timer
53
54      real (kind=real_kind), save ::   &
55           clock_rate       ! clock_rate in seconds for each cycle
56
57      real (kind=real_kind), dimension(max_timers), save ::   &
58           cputime          ! accumulated cpu time in each timer
59
60      character (len=8), dimension(max_timers), save ::   &
61           status           ! timer status string
62
63!***********************************************************************
64
65      contains
66
67!***********************************************************************
68
69      subroutine timer_check(timer)
70
71!-----------------------------------------------------------------------
72!
73!     This routine checks a given timer.  This is primarily used to
74!     periodically accumulate time in the timer to prevent timer cycles
75!     from wrapping around max_cycles.
76!
77!-----------------------------------------------------------------------
78
79!-----------------------------------------------------------------------
80!
81!     Input Variables:
82!
83!-----------------------------------------------------------------------
84
85      integer (kind=int_kind), intent(in) ::   &
86          timer            ! timer number
87
88!-----------------------------------------------------------------------
89
90      if (status(timer) .eq. 'running') then
91        call timer_stop (timer)
92        call timer_start(timer)
93      endif
94
95!-----------------------------------------------------------------------
96
97      end subroutine timer_check
98
99!***********************************************************************
100
101      subroutine timer_clear(timer)
102
103!-----------------------------------------------------------------------
104!
105!     This routine resets a given timer.
106!
107!-----------------------------------------------------------------------
108
109!-----------------------------------------------------------------------
110!
111!     Input Variables:
112!
113!-----------------------------------------------------------------------
114
115      integer (kind=int_kind), intent(in) ::   &
116          timer            ! timer number
117
118!-----------------------------------------------------------------------
119
120      cputime(timer) = 0.0_real_kind  ! clear the timer
121
122!-----------------------------------------------------------------------
123
124      end subroutine timer_clear
125
126!***********************************************************************
127
128      function timer_get(timer)
129
130!-----------------------------------------------------------------------
131!
132!     This routine returns the result of a given timer.  This can be
133!     called instead of timer_print so that the calling routine can
134!     print it in desired format.
135!
136!-----------------------------------------------------------------------
137
138!-----------------------------------------------------------------------
139!
140!     Input Variables:
141!
142!-----------------------------------------------------------------------
143
144      integer (kind=int_kind), intent(in) ::   &
145          timer            ! timer number
146
147!-----------------------------------------------------------------------
148!
149!     Output Variables:
150!
151!-----------------------------------------------------------------------
152
153      real (kind=real_kind) ::   &
154           timer_get   ! accumulated cputime in given timer
155
156!-----------------------------------------------------------------------
157
158      if (status(timer) .eq. 'stopped') then
159        timer_get = cputime(timer)
160      else
161        call timer_stop(timer)
162        timer_get = cputime(timer)
163        call timer_start(timer)
164      endif
165
166!-----------------------------------------------------------------------
167
168      end function timer_get
169
170!***********************************************************************
171
172      subroutine timer_print(timer)
173
174!-----------------------------------------------------------------------
175!
176!     This routine prints the accumulated cpu time in given timer.
177!
178!-----------------------------------------------------------------------
179
180!-----------------------------------------------------------------------
181!
182!     Input Variables:
183!
184!-----------------------------------------------------------------------
185
186      integer (kind=int_kind), intent(in) ::   &
187          timer            ! timer number
188
189!-----------------------------------------------------------------------
190
191      !---
192      !--- print the cputime accumulated for timer
193      !--- make sure timer is stopped
194      !---
195
196      if (status(timer) .eq. 'stopped') then
197        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
198             timer,cputime(timer)
199      else
200        call timer_stop(timer)
201        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
202             timer,cputime(timer)
203        call timer_start(timer)
204      endif
205
206!-----------------------------------------------------------------------
207
208      end subroutine timer_print
209
210!***********************************************************************
211
212      subroutine timer_start(timer)
213
214!-----------------------------------------------------------------------
215!
216!     This routine starts a given timer.
217!
218!-----------------------------------------------------------------------
219
220!-----------------------------------------------------------------------
221!
222!     Input Variables:
223!
224!-----------------------------------------------------------------------
225
226      integer (kind=int_kind), intent(in) ::   &
227          timer            ! timer number
228
229!-----------------------------------------------------------------------
230
231      !---
232      !--- Start the timer and change timer status.
233      !---
234
235      if (status(timer) .eq. 'stopped') then
236        call system_clock(count=cycles1(timer))
237        status(timer) = 'running'
238      endif
239
240!-----------------------------------------------------------------------
241
242      end subroutine timer_start
243
244!***********************************************************************
245
246      subroutine timer_stop(timer)
247
248!-----------------------------------------------------------------------
249!
250!     This routine stops a given timer.
251!
252!-----------------------------------------------------------------------
253
254!-----------------------------------------------------------------------
255!
256!     Input Variables:
257!
258!-----------------------------------------------------------------------
259
260      integer (kind=int_kind), intent(in) ::   &
261          timer            ! timer number
262
263!-----------------------------------------------------------------------
264
265      if (status(timer) .eq. 'running') then
266
267        !---
268        !--- Stop the desired timer.
269        !---
270
271        call system_clock(count=cycles2(timer))
272
273        !---
274        !--- check and correct for cycle wrapping
275        !---
276
277        if (cycles2(timer) .ge. cycles1(timer)) then
278          cputime(timer) = cputime(timer) + clock_rate*   &
279                           (cycles2(timer) - cycles1(timer))
280        else
281          cputime(timer) = cputime(timer) + clock_rate*   &
282                      (cycles2(timer) - cycles1(timer) + cycles_max)
283        endif
284
285        !---
286        !--- Change timer status.
287        !---
288
289        status(timer)='stopped'
290
291      endif
292
293!-----------------------------------------------------------------------
294
295      end subroutine timer_stop
296
297!***********************************************************************
298
299      subroutine timers_init
300
301!-----------------------------------------------------------------------
302!
303!     This routine initializes some machine parameters necessary for
304!     computing cpu time from F90 intrinsics.
305!
306!-----------------------------------------------------------------------
307
308      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
309
310!-----------------------------------------------------------------------
311
312      !---
313      !--- Initialize timer arrays and clock_rate.
314      !---
315
316      clock_rate = 0.0_real_kind
317      cycles1    = 0
318      cycles2    = 0
319      cputime    = 0.0_real_kind
320      status     = 'stopped'
321
322      !---
323      !--- Call F90 intrinsic system_clock to determine clock rate
324      !--- and maximum cycles.  If no clock available, print message.
325      !---
326
327      call system_clock(count_rate=cycles, count_max=cycles_max)
328
329      if (cycles /= 0) then
330        clock_rate = 1.0_real_kind/real(cycles)
331      else
332        clock_rate = 0.0_real_kind
333        print *, '--- No system clock available ---'
334      endif
335
336!-----------------------------------------------------------------------
337
338      end subroutine timers_init
339
340!***********************************************************************
341
342      end module timers
343
344!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Note: See TracBrowser for help on using the repository browser.