source: palm/trunk/SOURCE/progress_bar.f90 @ 1807

Last change on this file since 1807 was 1683, checked in by knoop, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 6.8 KB
Line 
1!> @file progress_bar.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2014 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: progress_bar.f90 1683 2015-10-07 23:57:51Z gronemeier $
26!
27! 1682 2015-10-07 23:56:08Z knoop
28! Code annotations made doxygen readable
29!
30! 1468 2014-09-24 14:06:57Z maronga
31! Added support for progress file PROGRESS which is used in case of batch jobs
32!
33! Description:
34! ------------
35!> This routine prints either a progress bar on the standard output in case of
36!> interactive runs, or it prints the progress in a separate file called
37!> PROGRESS.
38!------------------------------------------------------------------------------!
39 MODULE progress_bar
40 
41
42    USE control_parameters,                                                    &
43        ONLY : end_time, run_identifier, simulated_time,                       &
44               simulated_time_at_begin, time_restart
45
46    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                        &
47        ONLY :  OUTPUT_UNIT
48
49    USE kinds
50
51    IMPLICIT NONE
52
53    PRIVATE
54    PUBLIC   batch_job, finish_progress_bar, output_progress_bar
55
56    CHARACTER(LEN=60) ::  bar      !< progress bar, initially filled with "_"
57    CHARACTER(LEN=60) ::  crosses  !< filled with "X"
58
59    INTEGER(iwp) ::  ilength !< length of progress bar filled with "X"
60
61    LOGICAL ::  batch_job = .FALSE.   !< switch to determine the run mode
62
63    REAL(wp) ::  time_to_be_simulated !< in sec
64
65    LOGICAL ::  initialized = .FALSE. !< switch to determine if bar is initialized
66
67    SAVE
68
69 CONTAINS
70
71!------------------------------------------------------------------------------!
72! Description:
73! ------------
74!> Initialize the progress bar/file
75!------------------------------------------------------------------------------!
76 
77    SUBROUTINE init_progress_bar
78
79       IMPLICIT NONE
80
81!
82!--    Calculate the time to be simulated in this job
83!--    (in case of automatic restarts the calculated time will probably be
84!--    larger than the time which will actually be simulated)
85       IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time  .AND.&
86            time_restart > simulated_time_at_begin )  THEN
87          time_to_be_simulated = time_restart - simulated_time_at_begin
88       ELSE
89          time_to_be_simulated = end_time     - simulated_time_at_begin
90       ENDIF
91
92       IF ( batch_job )  THEN
93
94          CALL check_open ( 117 )
95          WRITE ( 117, FMT='(A20,/)' ) run_identifier
96
97       ELSE
98          bar = '____________________________________________________________'
99          crosses = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
100!
101!--       Line feed on stdout to seperate the progress bar from previous messages
102          WRITE ( OUTPUT_UNIT, '(1X)' )
103#if defined( __intel_compiler )
104!
105!--       The Intel compiler does not allow to immediately flush the output buffer
106!--       in case that option ADVANCE='NO' is used in the write statement.
107!--       A workaround is to set a special carriage control feature and use "+" as
108!--       first output character, but this non-standard and only available with the
109!--       Intel compiler
110          OPEN ( OUTPUT_UNIT, CARRIAGECONTROL='FORTRAN' )
111#endif
112
113       ENDIF
114
115       initialized = .TRUE.
116
117    END SUBROUTINE init_progress_bar
118
119
120!------------------------------------------------------------------------------!
121! Description:
122! ------------
123!> Print progress data to standard output (interactive) or to file (batch jobs)
124!------------------------------------------------------------------------------!
125 
126    SUBROUTINE output_progress_bar
127
128       IMPLICIT NONE
129
130       REAL(wp) ::  remaining_time_in_percent  !< remaining time to be simulated
131                                               !< in the job
132       REAL(wp) ::  remaining_time_in_percent_total !< total remaining time of
133                                                    !< the job chain
134
135       IF ( .NOT. initialized )  CALL init_progress_bar
136
137
138       remaining_time_in_percent =                                             &
139          ( simulated_time - simulated_time_at_begin ) / time_to_be_simulated
140
141       remaining_time_in_percent_total = ( simulated_time / end_time )
142
143!
144!--    In batch mode, use a file (PROGRESS), otherwise use progress bar
145       IF ( batch_job )  THEN
146
147          BACKSPACE ( 117 )
148          WRITE ( 117, FMT='(F5.2,1X,F5.2)' ) remaining_time_in_percent,       &
149                                              remaining_time_in_percent_total
150          CALL local_flush( 117 )
151
152       ELSE
153
154!
155!--       Calculate length of progress bar
156          ilength = remaining_time_in_percent * 60.0_wp
157          ilength = MIN( ilength, 60 )
158
159          bar(1:ilength) = crosses(1:ilength)
160
161#if defined( __intel_compiler )
162          WRITE ( OUTPUT_UNIT, '(A,6X,''['',A,''] '',F5.1,'' left'')' )        &
163                  '+', bar,                                                    &
164                   MAX( 0.0_wp, ( 1.0_wp - remaining_time_in_percent ) *       &
165                                  100.0_wp )
166#else
167          WRITE ( OUTPUT_UNIT, '(A,6X,''['',A,''] '',F5.1,'' left'')',         &
168                  ADVANCE='NO' )  CHAR( 13 ), bar,                             &
169                   MAX( 0.0_wp, ( 1.0_wp - remaining_time_in_percent ) *       &
170                                  100.0_wp )
171#endif
172          CALL local_flush( OUTPUT_UNIT )
173
174       ENDIF
175
176    END SUBROUTINE output_progress_bar
177
178!------------------------------------------------------------------------------!
179! Description:
180! ------------
181!> Finalization of the progress bar/file
182!------------------------------------------------------------------------------!
183 
184    SUBROUTINE finish_progress_bar
185
186       IMPLICIT NONE
187
188       IF ( batch_job )  THEN
189
190          CALL close_file ( 117 )
191
192       ELSE
193       
194#if defined( __intel_compiler )
195!
196!--       Reset to the default carriage control
197          OPEN ( OUTPUT_UNIT, CARRIAGECONTROL='LIST' )
198#endif
199!
200!--       Line feed when simulation has finished
201          WRITE ( OUTPUT_UNIT, '(1X)' )
202
203       ENDIF
204
205    END SUBROUTINE finish_progress_bar
206
207
208 END MODULE progress_bar
Note: See TracBrowser for help on using the repository browser.