source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_parallel/timer.f90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
  1. Zhang publication on coupling factor
  • Property svn:executable set to *
File size: 9.5 KB
Line 
1! ==============================================================================================================================
2! MODULE   : timer
3!
4! CONTACT      : orchidee-help _at_ listes.ipsl.fr
5!
6! LICENCE      : IPSL (2006)
7! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF     Timer functions to calculate MPI time consumption.
10!!
11!!\n DESCRIPTION  : Timer functions to calculate MPI time consumption (global time and mpi time).
12!!               - store in timer_state the state of the simulation (running, stopped, suspended)
13!!               - calcutate the cpu time in cpu_timer / the real time in real_timer
14!!               
15!!
16!! RECENT CHANGE(S): None
17!!
18!! REFERENCES(S)    : None
19!!
20!! SVN              :
21!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/timer.f90 $
22!! $Date: 2017-06-28 16:04:50 +0200 (Wed, 28 Jun 2017) $
23!! $Revision: 4470 $
24!! \n
25!_ ================================================================================================================================
26MODULE timer
27
28  USE mod_orchidee_para_var, ONLY : numout
29 
30  INTEGER, PARAMETER :: nb_timer=2
31  INTEGER, PARAMETER :: timer_global=1
32  INTEGER, PARAMETER :: timer_mpi=2
33  INTEGER, PARAMETER :: stopped = 1
34  INTEGER, PARAMETER :: running = 2
35  INTEGER, PARAMETER :: suspended = 3
36 
37  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: cpu_timer
38  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: real_timer
39  INTEGER, DIMENSION(nb_timer),SAVE :: timer_state
40  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: last_cpu_time
41  INTEGER, DIMENSION(nb_timer),SAVE :: last_real_time
42 
43 
44 
45 
46  CONTAINS
47 
48  !!  =============================================================================================================================
49  !! SUBROUTINE:  init_timer
50  !!
51  !>\BRIEF   Initialization of the timer.
52  !!
53  !! DESCRIPTION:  Initialization of the timer. Need to be called at the beginning of
54  !!               the simulation by the master threads OMP on each process mpi.
55  !!
56  !! \n
57  !_ ==============================================================================================================================
58  SUBROUTINE init_timer
59  IMPLICIT NONE
60   
61    cpu_timer(:)=0.
62    real_timer(:)=0.
63    timer_state(:)=stopped
64    last_cpu_time(:)=0.
65    last_real_time(:)=0
66   
67  END SUBROUTINE init_timer
68 
69 
70  !!  =============================================================================================================================
71  !! SUBROUTINE:  start_timer
72  !!
73  !>\BRIEF      Start all timer variables for the type of timer which was choosen (global timer or mpi timer)
74  !!
75  !! DESCRIPTION:       Start all timer variables for the type of timer which was choosen (global timer or mpi timer)
76  !!                   Need to be call by the master threads on each process mpi.       
77  !!
78  !! \n
79  !_ ==============================================================================================================================
80  SUBROUTINE start_timer(no_timer)
81  IMPLICIT NONE
82     INTEGER :: no_timer
83     DOUBLE PRECISION :: x
84     
85     IF (timer_state(no_timer)/=stopped) THEN
86       STOP 'start_timer :: timer is already running or suspended'
87     ELSE
88        timer_state(no_timer)=running
89     ENDIF
90     
91     cpu_timer(no_timer)=0. 
92     real_timer(no_timer)=0.
93     x=Diff_real_time(no_timer)
94     x=Diff_cpu_time(no_timer)
95     
96  END SUBROUTINE start_timer
97 
98 
99 
100  !!  =============================================================================================================================
101  !! SUBROUTINE:  stop_timer
102  !!
103  !>\BRIEF      This subroutine will change the value of timer_state from "running" to "stopped"
104  !!
105  !! DESCRIPTION:       This subroutine will change the value of timer_state from "running" to "stopped"         
106  !!
107  !! \n
108  !_ ==============================================================================================================================
109  SUBROUTINE stop_timer(no_timer)
110  IMPLICIT NONE
111    INTEGER :: no_timer
112   
113     IF (timer_state(no_timer)==running) THEN
114        CALL suspend_timer(no_timer)
115     ELSE IF (timer_state(no_timer)==stopped) THEN
116       WRITE(numout,*) 'stop_timer :: timer is already stopped'
117     ENDIF
118
119     timer_state(no_timer)=stopped
120
121  END SUBROUTINE stop_timer
122 
123 
124 
125  !!  =============================================================================================================================
126  !! SUBROUTINE:  resume_timer
127  !!
128  !>\BRIEF      This subroutine will change the value of timer_state from suspended to running and update diff_cpu_time and diff_real_time
129  !!
130  !! DESCRIPTION:       This subroutine will change the value of timer_state from suspended to running and
131  !!                update diff_cpu_time and diff_real_time
132  !!
133  !! \n
134  !_ ==============================================================================================================================
135  SUBROUTINE resume_timer(no_timer)
136  IMPLICIT NONE
137    INTEGER :: no_timer
138    DOUBLE PRECISION :: x
139     IF (timer_state(no_timer)/=suspended) THEN
140       STOP 'resume_timer :: timer is not suspended'
141     ELSE
142        timer_state(no_timer)=running
143     ENDIF
144 
145     x=Diff_cpu_time(no_timer)
146     x=Diff_real_time(no_timer) 
147 
148  END SUBROUTINE resume_timer
149 
150 
151 
152  !!  =============================================================================================================================
153  !! SUBROUTINE:  suspend_timer
154  !!
155  !>\BRIEF      This subroutine will change the value of timer_state from running to suspended and update cpu_timer
156  !!
157  !! DESCRIPTION:    This subroutine will change the value of timer_state from running to suspended and update cpu_timer
158  !!
159  !! \n
160  !_ ==============================================================================================================================
161  SUBROUTINE suspend_timer(no_timer)
162 
163    IMPLICIT NONE
164    INTEGER :: no_timer
165   
166     IF (timer_state(no_timer)/=running) THEN
167       STOP 'suspend_timer :: timer is not running'
168     ELSE
169        timer_state(no_timer)=suspended
170     ENDIF
171 
172     cpu_timer(no_timer)=cpu_timer(no_timer)+Diff_cpu_time(no_timer)
173     real_timer(no_timer)=real_timer(no_timer)+Diff_real_time(no_timer)
174 
175  END SUBROUTINE suspend_timer
176 
177 
178  !!  =============================================================================================================================
179  !! FUNCTION:  diff_real_time
180  !!
181  !>\BRIEF      Calculate the increment of real time since the last call to diff_real_time
182  !!
183  !! DESCRIPTION:        Calculate the increment of real time since the last call to diff_real_time
184  !!
185  !! \n
186  !_ ==============================================================================================================================
187  FUNCTION diff_real_time(no_timer)
188  IMPLICIT NONE
189    INTEGER :: no_timer
190    DOUBLE PRECISION :: Diff_real_Time
191    integer :: Last_Count,count,count_rate,count_max
192   
193    Last_Count=Last_real_time(no_timer)
194   
195    call system_clock(count,count_rate,count_max)
196    if (Count>=Last_Count) then
197      Diff_real_time=(1.*(Count-last_Count))/count_rate
198    else
199      Diff_real_time=(1.*(Count-last_Count+Count_max))/count_rate
200    endif
201    Last_real_time(no_timer)=Count
202   
203  END FUNCTION diff_real_time
204 
205  !!  =============================================================================================================================
206  !! FUNCTION:  Diff_Cpu_Time
207  !!
208  !>\BRIEF     Calculate the increment of cpu time since the last call to diff_real_time       
209  !!
210  !! DESCRIPTION:        Calculate the increment of cpu time since the last call to diff_real_time     
211  !!
212  !! \n
213  !_ ==============================================================================================================================
214  function Diff_Cpu_Time(no_timer)
215  implicit none
216    INTEGER :: no_timer
217    DOUBLE PRECISION :: Diff_Cpu_Time
218    DOUBLE PRECISION :: Last_Count,Count
219   
220    Last_Count=Last_cpu_time(no_timer)
221   
222    call cpu_time(Count)
223    Diff_Cpu_Time=Count-Last_Count
224    Last_cpu_time(no_timer)=Count
225   
226  end function Diff_Cpu_Time
227 
228  !!  =============================================================================================================================
229  !! FUNCTION:  Get_cpu_time
230  !!
231  !>\BRIEF      Return the value of cpu_timer
232  !!
233  !! DESCRIPTION:       This subroutine will return the value of cpu_timer
234  !!
235  !! \n
236  !_ ==============================================================================================================================
237  FUNCTION Get_cpu_time(no_timer)
238  IMPLICIT NONE
239  INTEGER :: no_timer
240  DOUBLE PRECISION :: Get_cpu_time
241 
242    IF (timer_state(no_timer)==running) THEN
243      CALL suspend_timer(no_timer)
244      Get_cpu_time=cpu_timer(no_timer)
245      CALL resume_timer(no_timer)
246    ELSE
247      Get_cpu_time=cpu_timer(no_timer)
248    ENDIF
249   
250  END FUNCTION Get_cpu_time
251 
252  !!  =============================================================================================================================
253  !! FUNCTION:  Get_real_time
254  !!
255  !>\BRIEF              Return the value of real_timer
256  !!
257  !! DESCRIPTION: This subroutine will return the value of real_timer
258  !!
259  !! \n
260  !_ ==============================================================================================================================
261  FUNCTION Get_real_time(no_timer)
262  IMPLICIT NONE
263  INTEGER :: no_timer
264  DOUBLE PRECISION :: Get_real_time
265 
266    IF (timer_state(no_timer)==running) THEN
267      CALL suspend_timer(no_timer)
268      Get_real_time=real_timer(no_timer)
269      CALL resume_timer(no_timer)
270    ELSE
271      Get_real_time=real_timer(no_timer)
272    ENDIF
273 
274  END FUNCTION Get_real_time
275 
276END MODULE Timer
277 
Note: See TracBrowser for help on using the repository browser.