source: palm/tags/release-3.2b/SOURCE/local_tremain.f90 @ 3636

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

New:
---

Changed:


PALM can be generally installed on any kind of Linux-, IBM-AIX-, or NEC-SX-system by adding appropriate settings to the configuration file.

Scripts are also running under the public domain ksh.

All system relevant compile and link options as well as the host identifier (local_host) are specified in the configuration file.

Filetransfer by ftp removed (options -f removed from mrun and mbuild).

Call of (system-)FLUSH routine moved to new routine local_flush.

return_addres and return_username are read from ENVPAR-NAMELIST-file instead of using local_getenv.

Preprocessor strings for different linux clusters changed to "lc", some preprocessor directives renamed (new: intel_openmp_bug), preprocessor directives for old systems removed

advec_particles, check_open, cpu_log, cpu_statistics, data_output_dvrp, flow_statistics, header, init_dvrp, init_particles, init_1d_model, init_dvrp, init_pegrid, local_getenv, local_system, local_tremain, local_tremain_ini, modules, palm, parin, run_control

new:
local_flush

mbuild, mrun

Errors:


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