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

Last change on this file since 82 was 82, checked in by raasch, 17 years ago

vorlaeufige Standalone-Version fuer Linux-Cluster

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