source: palm/tags/release-3.9/SOURCE/cpu_log.f90 @ 4480

Last change on this file since 4480 was 1037, checked in by raasch, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 5.3 KB
Line 
1 SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: cpu_log.f90 1037 2012-10-22 14:10:22Z Giersch $
27!
28! 1036 2012-10-22 13:43:42Z raasch
29! code put under GPL (PALM 3.9)
30!
31! 274 2009-03-26 15:11:21Z heinze
32! Output of messages replaced by message handling routine.
33! Type of count and count_rate changed to default INTEGER on NEC machines
34!
35! 225 2009-01-26 14:44:20Z raasch
36! Type of count and count_rate changed to INTEGER(8)
37!
38! 82 2007-04-16 15:40:52Z raasch
39! Preprocessor strings for different linux clusters changed to "lc",
40! preprocessor directives for old systems removed
41!
42! RCS Log replace by Id keyword, revision history cleaned up
43!
44! Revision 1.24  2006/06/02 15:12:17  raasch
45! cpp-directives extended for lctit
46!
47! Revision 1.1  1997/07/24 11:12:29  raasch
48! Initial revision
49!
50!
51! Description:
52! ------------
53! Cpu-time measurements for any program part whatever.
54!------------------------------------------------------------------------------!
55
56    USE control_parameters
57    USE cpulog
58    USE pegrid
59
60    IMPLICIT NONE
61
62    CHARACTER (LEN=*)           ::  modus, place
63    CHARACTER (LEN=*), OPTIONAL ::  barrierwait
64    LOGICAL, SAVE               ::  first = .TRUE.
65    REAL                        ::  mtime = 0.0, mtimevec = 0.0
66    TYPE(logpoint)              ::  log_event
67
68#if defined( __lc ) || defined( __decalpha )
69    INTEGER(8)                  ::  count, count_rate
70#elif defined( __nec )
71    INTEGER                     ::  count, count_rate
72#elif defined( __ibm )
73    INTEGER(8)                  ::  IRTC
74#endif
75
76
77!
78!-- Initialize and check, respectively, point of measurement
79    IF ( log_event%place == ' ' )  THEN
80       log_event%place = place
81    ELSEIF ( log_event%place /= place )  THEN
82       WRITE( message_string, * ) 'wrong argument & expected: ', &
83                         TRIM(log_event%place), '  given: ',  TRIM( place )
84       CALL message( 'cpu_log', 'PA0174', 1, 2, 0, 6, 0 )
85    ENDIF
86
87!
88!-- Take current time
89#if defined( __lc ) || defined( __decalpha ) || defined( __nec )
90    CALL SYSTEM_CLOCK( count, count_rate )
91    mtime = REAL( count ) / REAL( count_rate )
92#elif defined( __ibm )
93    mtime = IRTC( ) * 1E-9
94#else
95    message_string = 'no time measurement defined on this host'
96    CALL message( 'cpu_log', 'PA0175', 1, 2, 0, 6, 0 )
97#endif
98
99!
100!-- Start, stop or pause measurement
101    IF ( modus == 'start'  .OR.  modus == 'continue' )  THEN
102       log_event%mtime    = mtime
103       log_event%mtimevec = mtimevec
104    ELSEIF ( modus == 'pause' )  THEN
105       IF ( ( mtime - log_event%mtime ) < 0.0  .AND.  first )  THEN
106          WRITE( message_string, * ) 'negative time interval occured',         &
107                      ' &PE',myid,' L=PAUSE "',TRIM(log_event%place),'" new=', &
108                      mtime,' last=',log_event%mtime
109          CALL message( 'cpu_log', 'PA0176', 0, 1, -1, 6, 0 )
110          first = .FALSE.
111       ENDIF
112       log_event%isum     = log_event%isum + mtime - log_event%mtime
113       log_event%ivect    = log_event%ivect  + mtimevec - log_event%mtimevec
114    ELSEIF ( modus == 'stop' )  THEN
115       IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0  .AND. &
116            first )  THEN
117          WRITE( message_string, * ) 'negative time interval occured',        &
118                      ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', &
119                      mtime,' last=',log_event%mtime,' isum=',log_event%isum
120          CALL message( 'cpu_log', 'PA0177', 0, 1, -1, 6, 0 )
121          first = .FALSE.
122       ENDIF
123       log_event%mtime    = mtime    - log_event%mtime    + log_event%isum
124       log_event%mtimevec = mtimevec - log_event%mtimevec + log_event%ivect
125       log_event%sum      = log_event%sum  + log_event%mtime
126       IF ( log_event%sum < 0.0  .AND.  first )  THEN
127          WRITE( message_string, * ) 'negative time interval occured',        &
128                      ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', &
129                                      log_event%sum,' mtime=',log_event%mtime
130          CALL message( 'cpu_log', 'PA0178', 0, 1, -1, 6, 0 )
131          first = .FALSE.
132       ENDIF
133       log_event%vector   = log_event%vector + log_event%mtimevec
134       log_event%counts   = log_event%counts + 1
135       log_event%isum     = 0.0
136       log_event%ivect    = 0.0
137    ELSE
138       message_string = 'unknown modus of time measurement: ' // TRIM( modus )
139       CALL message( 'cpu_log', 'PA0179', 0, 1, -1, 6, 0 )
140    ENDIF
141
142
143 END SUBROUTINE cpu_log
Note: See TracBrowser for help on using the repository browser.