source: palm/trunk/UTIL/inifor/src/inifor_control.f90

Last change on this file was 4843, checked in by raasch, 4 years ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

  • Property svn:keywords set to Id
File size: 13.1 KB
Line 
1!> @file src/inifor_control.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! 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 2017-2021 Leibniz Universitaet Hannover
18! Copyright 2017-2021 Deutscher Wetterdienst Offenbach
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: inifor_control.f90 4843 2021-01-15 15:22:11Z banzhafs $
28! Improve visibility of errors by printing them below warnings listing
29!
30!
31! 4659 2020-08-31 11:21:17Z eckhard
32! List warnings after successful run or abort
33! Produce failure exit code (1) on program abort for test automation
34! Improved code formatting
35!
36!
37! 4523 2020-05-07 15:58:16Z eckhard
38! respect integer working precision (iwp) specified in inifor_defs.f90
39!
40!
41! 4481 2020-03-31 18:55:54Z maronga
42! Change output format in routine report to allow for better message formatting
43!
44! 3997 2019-05-23 12:35:57Z eckhard
45! Added warnings counter
46!
47!
48! 3866 2019-04-05 14:25:01Z eckhard
49! Use PALM's working precision
50! Renamed run_control -> log_runtime
51! Open log file only once
52! Improved coding style
53!
54!
55! 3785 2019-03-06 10:41:14Z eckhard
56! Added message buffer for displaying tips to rectify encountered errors
57!
58!
59! 3618 2018-12-10 13:25:22Z eckhard
60! Prefixed all INIFOR modules with inifor_
61!
62!
63! 3614 2018-12-10 07:05:46Z raasch
64! abort renamed inifor_abort to avoid intrinsic problem in Fortran
65!
66! 3557 2018-11-22 16:01:22Z eckhard
67! Updated documentation
68!
69!
70! 3447 2018-10-29 15:52:54Z eckhard
71! Renamed source files for compatibilty with PALM build system
72!
73!
74! 3395 2018-10-22 17:32:49Z eckhard
75! Suppress debugging messages unless --debug option is given
76!
77!
78! 3183 2018-07-27 14:25:55Z suehring
79! Added version and copyright output
80!
81!
82! 3182 2018-07-27 13:36:03Z suehring
83! Initial revision
84!
85!
86!
87! Authors:
88! --------
89!> @author Eckhard Kadasch (Deutscher Wetterdienst, Offenbach)
90!
91! Description:
92! ------------
93!> The control module provides routines for timing INIFOR and writing runtime
94!> feedback to the terminal and a log file.
95!------------------------------------------------------------------------------!
96 MODULE inifor_control
97
98    USE inifor_defs,                                                           &
99        ONLY:  COPYRIGHT, LNAME, LOG_FILE_NAME, PATH, VERSION, iwp, wp
100    USE inifor_util,                                                           &
101        ONLY:  real_to_str, real_to_str_f, str
102
103    IMPLICIT NONE
104
105    INTEGER(iwp), SAVE         ::  u                     !< Fortran file unit for the log file
106    INTEGER(iwp), PARAMETER    ::  n_max_wrngs = 512     !< Fortran file unit for the log file
107    INTEGER(iwp), SAVE         ::  n_wrngs = 0           !< Fortran file unit for the log file
108    CHARACTER (LEN=5000)       ::  message = ''          !< log message buffer
109    CHARACTER (LEN=5000)       ::  tip     = ''          !< optional log message buffer for tips on how to rectify encountered errors
110    CHARACTER (LEN=5000), SAVE ::  warnings(n_max_wrngs) !< log of warnings
111
112 CONTAINS
113
114!------------------------------------------------------------------------------!
115! Description:
116! ------------
117!>
118!> report() is INIFOR's general logging routine. It prints the given 'message'
119!> to the terminal and writes it to the INIFOR log file.
120!>
121!> You can use this routine to log events across INIFOR's code to log. For
122!> warnings and abort messages, you may use the dedicated routines warn() and
123!> inifor_abort() in this module. Both use report() and add specific behaviour
124!> to it.
125!------------------------------------------------------------------------------!
126 SUBROUTINE report( routine, message, debug )
127
128    CHARACTER(LEN=*), INTENT(IN)  ::  routine !< name of calling subroutine of function
129    CHARACTER(LEN=*), INTENT(IN)  ::  message !< log message
130    LOGICAL, OPTIONAL, INTENT(IN) ::  debug   !< flag the current message as debugging message
131
132    LOGICAL, SAVE                 ::  is_first_run = .TRUE. !< control flag for file opening mode
133    LOGICAL                       ::  suppress_message      !< control falg for additional debugging log
134
135    IF ( is_first_run )  THEN
136       OPEN( NEWUNIT=u, FILE=LOG_FILE_NAME, STATUS='replace' )
137       is_first_run = .FALSE.
138    ENDIF
139       
140
141    suppress_message = .FALSE.
142    IF ( PRESENT( debug ) )  THEN
143       IF ( .NOT. debug )  suppress_message = .TRUE.
144    ENDIF
145
146    IF ( .NOT. suppress_message )  THEN
147       CALL write_to_sdtout_and_logfile(                                       &
148          TRIM( message ) // "  [ " // TRIM( routine ) // " ]"                 &
149       )
150    ENDIF
151
152 END SUBROUTINE report
153
154
155!------------------------------------------------------------------------------!
156! Description:
157! ------------
158!> This routine writes the given message to SDTOUT as well as to the INIFOR log
159!> file.
160!------------------------------------------------------------------------------!
161 SUBROUTINE write_to_sdtout_and_logfile( message )
162
163    CHARACTER(LEN=*), INTENT(IN)  ::  message
164
165    WRITE(*, '(A)') "inifor: " // TRIM( message )
166    WRITE(u, '(A)') TRIM( message )
167
168 END SUBROUTINE write_to_sdtout_and_logfile
169
170
171!------------------------------------------------------------------------------!
172! Description:
173! ------------
174!>
175!> warn() prepends "WARNING:" the given 'message' and prints the result to the
176!> terminal and writes it to the INIFOR logfile.
177!>
178!> You can use this routine for messaging issues, that still allow INIFOR to
179!> continue.
180!------------------------------------------------------------------------------!
181 SUBROUTINE warn( routine, message )
182
183    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
184    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
185
186    CALL cache_warning( routine, message )
187    CALL report( routine, "WARNING: " // TRIM( message ) )
188
189 END SUBROUTINE warn
190
191
192 SUBROUTINE cache_warning( routine, message )
193
194    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
195    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
196
197    n_wrngs = n_wrngs + 1
198    warnings(n_wrngs) = "  WARNING: " // TRIM( message ) //                      &
199                        "  [ " // TRIM( routine ) // " ]"
200
201 END SUBROUTINE cache_warning
202
203
204!------------------------------------------------------------------------------!
205! Description:
206! ------------
207!>
208!> This routine writes all warnings cached with cache_warning() to STDOUT
209!> and the INIFOR log file.
210!------------------------------------------------------------------------------!
211 SUBROUTINE report_warnings()
212
213    INTEGER(iwp)        ::  warning_idx
214    CHARACTER (LEN=500) ::  warning = ''
215
216    IF (n_wrngs > 0)  THEN
217       warning = 'Encountered the following '// TRIM( str( n_wrngs ) ) // " warning(s) during this run:"
218       CALL report( 'report_warnings', warning)
219
220       DO warning_idx = 1, n_wrngs
221          CALL write_to_sdtout_and_logfile( warnings(warning_idx) )
222       ENDDO
223    ENDIF
224
225 END SUBROUTINE report_warnings
226
227!------------------------------------------------------------------------------!
228! Description:
229! ------------
230!>
231!> Report successful run. To be called at the end of the main loop.
232!------------------------------------------------------------------------------!
233 SUBROUTINE report_success( output_file_name )
234
235    CHARACTER(LEN=PATH), INTENT(IN) ::  output_file_name
236
237    message = "Finished writing dynamic driver '" // TRIM( output_file_name )
238    message = TRIM( message ) // "' successfully."
239    IF (n_wrngs > 0)  THEN
240       message = TRIM( message ) // " Some warnings were encountered, see above."
241    ENDIF
242    CALL report( 'main loop', message )
243
244 END SUBROUTINE report_success
245   
246
247!------------------------------------------------------------------------------!
248! Description:
249! ------------
250!>
251!> Report runtime statistics
252!------------------------------------------------------------------------------!
253 SUBROUTINE report_runtime()
254
255    CALL log_runtime( 'report', 'void' )
256
257 END SUBROUTINE report_runtime
258
259
260!------------------------------------------------------------------------------!
261! Description:
262! ------------
263!>
264!> inifor_abort() prepends "ERROR:" the given 'message' and prints the result to
265!> stdout, writes it to the INIFOR logfile, and exits INIFOR.
266!>
267!> You can use this routine for messaging issues, that are critical and prevent
268!> INIFOR from continueing.
269!------------------------------------------------------------------------------!
270 SUBROUTINE inifor_abort( routine , message )
271
272    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
273    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
274
275    CALL report_warnings
276    CALL report( routine, "ERROR: " // TRIM( message ) // " Stopping." )
277    CALL close_log
278    CALL EXIT(1)
279
280 END SUBROUTINE inifor_abort
281
282
283 SUBROUTINE close_log()
284
285    CLOSE( u )
286
287 END SUBROUTINE close_log
288
289
290!------------------------------------------------------------------------------!
291! Description:
292! ------------
293!>
294!> print_version() prints the INIFOR version number and copyright notice.
295!------------------------------------------------------------------------------!
296 SUBROUTINE print_version()
297    PRINT *, "INIFOR " // VERSION
298    PRINT *, COPYRIGHT
299 END SUBROUTINE print_version
300
301
302!------------------------------------------------------------------------------!
303! Description:
304! ------------
305!>
306!> log_runtime() measures the run times of various parts of INIFOR and
307!> accumulates them in timing budgets.
308!------------------------------------------------------------------------------!
309 SUBROUTINE log_runtime( mode, budget )
310
311    CHARACTER(LEN=*), INTENT(IN) ::  mode   !< name of the calling mode
312    CHARACTER(LEN=*), INTENT(IN) ::  budget !< name of the timing budget
313
314    REAL(wp), SAVE ::  t0               !< begin of timing interval
315    REAL(wp), SAVE ::  t1               !< end of timing interval
316    REAL(wp), SAVE ::  t_comp  = 0.0_wp !< computation timing budget
317    REAL(wp), SAVE ::  t_alloc = 0.0_wp !< allocation timing budget
318    REAL(wp), SAVE ::  t_init  = 0.0_wp !< initialization timing budget
319    REAL(wp), SAVE ::  t_read  = 0.0_wp !< reading timing budget
320    REAL(wp), SAVE ::  t_total = 0.0_wp !< total time
321    REAL(wp), SAVE ::  t_write = 0.0_wp !< writing timing budget
322
323    CHARACTER(LEN=*), PARAMETER  ::  fmt='(F6.2)' !< floating-point output format
324
325
326    SELECT CASE( TRIM( mode ) )
327
328    CASE( 'init' )
329       CALL CPU_TIME(t0)
330
331    CASE( 'time' )
332
333       CALL CPU_TIME(t1)
334
335       SELECT CASE( TRIM( budget ) )
336
337          CASE( 'alloc' )
338             t_alloc = t_alloc + t1 - t0
339
340          CASE( 'init' )
341             t_init = t_init + t1 - t0
342
343          CASE( 'read' )
344             t_read = t_read + t1 - t0
345
346          CASE( 'write' )
347             t_write = t_write + t1 - t0
348
349          CASE( 'comp' )
350             t_comp = t_comp + t1 - t0
351
352          CASE DEFAULT
353             CALL inifor_abort(                                                &
354                'log_runtime',                                                 &
355                "Time Budget '" // TRIM( mode ) // "' is not supported."       &
356             )
357
358       END SELECT
359
360       t0 = t1
361
362    CASE( 'report' )
363        t_total = t_init + t_read + t_write + t_comp
364
365        CALL report( 'log_runtime', "*** CPU time ***" )
366
367        CALL report( 'log_runtime', "Initialization:  " // TRIM( real_to_str( t_init ) ) // &
368                     " s  (" // TRIM( real_to_str( 100 * t_init / t_total, fmt ) ) // " %)" )
369
370        CALL report( 'log_runtime', "(De-)Allocation: " // TRIM( real_to_str( t_alloc ) ) // &
371                     " s  (" // TRIM( real_to_str( 100 * t_alloc / t_total, fmt ) ) // " %)" )
372
373        CALL report( 'log_runtime', "Reading data:    " // TRIM( real_to_str( t_read ) )  // &
374                     " s  (" // TRIM( real_to_str( 100 * t_read / t_total, fmt ) ) // " %)" )
375
376        CALL report( 'log_runtime', "Writing data:    " // TRIM( real_to_str( t_write ) ) // &
377                     " s  (" // TRIM( real_to_str( 100 * t_write / t_total, fmt ) ) // " %)" )
378
379        CALL report( 'log_runtime', "Computation:     " // TRIM( real_to_str( t_comp ) )  // &
380                     " s  (" // TRIM( real_to_str( 100 * t_comp / t_total, fmt) ) // " %)" )
381
382        CALL report( 'log_runtime', "Total:           " // TRIM( real_to_str( t_total ) ) // &
383                     " s  (" // TRIM( real_to_str( 100 * t_total / t_total, fmt ) ) // " %)" )
384
385    CASE DEFAULT
386       CALL inifor_abort( 'log_runtime', "Mode '" // TRIM(mode) // "' is not supported." )
387
388    END SELECT
389
390 END SUBROUTINE log_runtime
391
392
393 END MODULE inifor_control
Note: See TracBrowser for help on using the repository browser.