source: palm/trunk/SOURCE/local_tremain.f90 @ 225

Last change on this file since 225 was 225, checked in by raasch, 15 years ago

bugfixes concerning cpu time measurements and calculation of spectra in case of multigrid method switched on

  • Property svn:keywords set to Id
File size: 1.9 KB
Line 
1 SUBROUTINE local_tremain( remaining_time )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Type of count and count_rate changed to INTEGER(8) in order to avoid out of
7! range problems (which result in measured negative time intervals)
8!
9! Former revisions:
10! -----------------
11! $Id: local_tremain.f90 225 2009-01-26 14:44:20Z raasch $
12!
13! 82 2007-04-16 15:40:52Z raasch
14! Preprocessor strings for different linux clusters changed to "lc",
15! preprocessor directives for old systems removed
16!
17! RCS Log replace by Id keyword, revision history cleaned up
18!
19! Revision 1.14  2006/06/02 15:20:33  raasch
20! Extended to TIT Sun Fire X4600 System (lctit)
21!
22! Revision 1.1  1998/03/18 20:14:47  raasch
23! Initial revision
24!
25!
26! Description:
27! ------------
28! For different operating systems get the remaining cpu-time of the job
29!------------------------------------------------------------------------------!
30
31    USE control_parameters
32    USE cpulog
33    USE pegrid
34
35    IMPLICIT NONE
36
37    REAL ::  remaining_time
38#if defined( __ibm )
39    INTEGER(8) ::  IRTC
40    REAL       ::  actual_wallclock_time
41#elif defined( __lc )
42    INTEGER(8) ::  count, count_rate
43    REAL       ::  actual_wallclock_time
44#endif
45
46#if defined( __ibm )
47
48    actual_wallclock_time = IRTC( ) * 1E-9
49    remaining_time = maximum_cpu_time_allowed - &
50                     ( actual_wallclock_time - initial_wallclock_time )
51
52#elif defined( __lc )
53
54    CALL SYSTEM_CLOCK( count, count_rate )
55    actual_wallclock_time = REAL( count ) / REAL( count_rate )
56    remaining_time = maximum_cpu_time_allowed - &
57                     ( actual_wallclock_time - initial_wallclock_time )
58
59#elif defined( __nec )
60   
61    CALL TREMAIN( remaining_time )
62    remaining_time = remaining_time / tasks_per_node
63
64#else
65
66!
67!-- No stop due to running out of cpu-time on other machines
68    remaining_time = 9999999.9
69
70#endif
71
72 END SUBROUTINE local_tremain
Note: See TracBrowser for help on using the repository browser.