Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Aug 31, 2020 11:21:17 AM (4 years ago)
Author:
eckhard
Message:

inifor: Support for COSMO cloud water and precipitation

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/UTIL/inifor/src/inifor_control.f90

    r4523 r4659  
    2121! Current revisions:
    2222! -----------------
    23 ! 
    24 ! 
     23!
     24!
    2525! Former revisions:
    2626! -----------------
    2727! $Id$
     28! List warnings after successful run or abort
     29! Produce failure exit code (1) on program abort for test automation
     30! Improved code formatting
     31!
     32!
     33! 4523 2020-05-07 15:58:16Z eckhard
    2834! respect integer working precision (iwp) specified in inifor_defs.f90
    2935!
    … …  
    8793
    8894    USE inifor_defs,                                                           &
    89         ONLY:  COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, iwp, wp
     95        ONLY:  COPYRIGHT, LNAME, LOG_FILE_NAME, PATH, VERSION, iwp, wp
    9096    USE inifor_util,                                                           &
    91         ONLY:  real_to_str, real_to_str_f
     97        ONLY:  real_to_str, real_to_str_f, str
    9298
    9399    IMPLICIT NONE
    94100
    95     CHARACTER (LEN=5000) ::  message = '' !< log message buffer
    96     CHARACTER (LEN=5000) ::  tip     = '' !< optional log message buffer for tips on how to rectify encountered errors
    97     INTEGER(iwp), SAVE        ::  u            !< Fortran file unit for the log file
    98     INTEGER(iwp), SAVE        ::  n_wrngs = 0  !< Fortran file unit for the log file
     101    INTEGER(iwp), SAVE         ::  u                     !< Fortran file unit for the log file
     102    INTEGER(iwp), PARAMETER    ::  n_max_wrngs = 512     !< Fortran file unit for the log file
     103    INTEGER(iwp), SAVE         ::  n_wrngs = 0           !< Fortran file unit for the log file
     104    CHARACTER (LEN=5000)       ::  message = ''          !< log message buffer
     105    CHARACTER (LEN=5000)       ::  tip     = ''          !< optional log message buffer for tips on how to rectify encountered errors
     106    CHARACTER (LEN=5000), SAVE ::  warnings(n_max_wrngs) !< log of warnings
    99107
    100108 CONTAINS
    … …  
    112120!> to it.
    113121!------------------------------------------------------------------------------!
    114  SUBROUTINE report(routine, message, debug)
     122 SUBROUTINE report( routine, message, debug )
    115123
    116124    CHARACTER(LEN=*), INTENT(IN)  ::  routine !< name of calling subroutine of function
    … …  
    128136
    129137    suppress_message = .FALSE.
    130     IF ( PRESENT(debug) )  THEN
     138    IF ( PRESENT( debug ) )  THEN
    131139       IF ( .NOT. debug )  suppress_message = .TRUE.
    132140    ENDIF
    133141
    134142    IF ( .NOT. suppress_message )  THEN
    135        WRITE(*, '(A)') "inifor: " // TRIM(message) // "  [ " // TRIM(routine) // " ]"
    136        WRITE(u, '(A)')  TRIM(message) // "  [ " // TRIM(routine) // " ]"
     143       CALL write_to_sdtout_and_logfile(                                       &
     144          TRIM( message ) // "  [ " // TRIM( routine ) // " ]"                 &
     145       )
    137146    ENDIF
    138147
    139148 END SUBROUTINE report
     149
     150
     151!------------------------------------------------------------------------------!
     152! Description:
     153! ------------
     154!> This routine writes the given message to SDTOUT as well as to the INIFOR log
     155!> file.
     156!------------------------------------------------------------------------------!
     157 SUBROUTINE write_to_sdtout_and_logfile( message )
     158
     159    CHARACTER(LEN=*), INTENT(IN)  ::  message
     160
     161    WRITE(*, '(A)') "inifor: " // TRIM( message )
     162    WRITE(u, '(A)') TRIM( message )
     163
     164 END SUBROUTINE write_to_sdtout_and_logfile
    140165
    141166
    … …  
    150175!> continue.
    151176!------------------------------------------------------------------------------!
    152  SUBROUTINE warn(routine, message)
     177 SUBROUTINE warn( routine, message )
    153178
    154179    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
    155180    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
    156181
     182    CALL cache_warning( routine, message )
     183    CALL report( routine, "WARNING: " // TRIM( message ) )
     184
     185 END SUBROUTINE warn
     186
     187
     188 SUBROUTINE cache_warning( routine, message )
     189
     190    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
     191    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
     192
    157193    n_wrngs = n_wrngs + 1
    158     CALL report(routine, "WARNING: " // TRIM(message))
    159 
    160  END SUBROUTINE warn
     194    warnings(n_wrngs) = "  WARNING: " // TRIM( message ) //                      &
     195                        "  [ " // TRIM( routine ) // " ]"
     196
     197 END SUBROUTINE cache_warning
     198
     199
     200!------------------------------------------------------------------------------!
     201! Description:
     202! ------------
     203!>
     204!> This routine writes all warnings cached with cache_warning() to STDOUT
     205!> and the INIFOR log file.
     206!------------------------------------------------------------------------------!
     207 SUBROUTINE report_warnings()
     208
     209    INTEGER(iwp) ::  warning_idx
     210
     211    IF (n_wrngs > 0)  THEN
     212       message = 'Encountered the following '// TRIM( str( n_wrngs ) ) // " warning(s) during this run:"
     213       CALL report( 'report_warnings', message )
     214
     215       DO warning_idx = 1, n_wrngs
     216          CALL write_to_sdtout_and_logfile( warnings(warning_idx) )
     217       ENDDO
     218    ENDIF
     219
     220 END SUBROUTINE report_warnings
     221
     222!------------------------------------------------------------------------------!
     223! Description:
     224! ------------
     225!>
     226!> Report successful run. To be called at the end of the main loop.
     227!------------------------------------------------------------------------------!
     228 SUBROUTINE report_success( output_file_name )
     229
     230    CHARACTER(LEN=PATH), INTENT(IN) ::  output_file_name
     231
     232    message = "Finished writing dynamic driver '" // TRIM( output_file_name )
     233    message = TRIM( message ) // "' successfully."
     234    IF (n_wrngs > 0)  THEN
     235       message = TRIM( message ) // " Some warnings were encountered."
     236    ENDIF
     237    CALL report( 'main loop', message )
     238
     239 END SUBROUTINE report_success
     240   
     241
     242!------------------------------------------------------------------------------!
     243! Description:
     244! ------------
     245!>
     246!> Report runtime statistics
     247!------------------------------------------------------------------------------!
     248 SUBROUTINE report_runtime()
     249
     250    CALL log_runtime( 'report', 'void' )
     251
     252 END SUBROUTINE report_runtime
    161253
    162254
    … …  
    171263!> INIFOR from continueing.
    172264!------------------------------------------------------------------------------!
    173  SUBROUTINE inifor_abort(routine, message)
     265 SUBROUTINE inifor_abort( routine , message )
    174266
    175267    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
    176268    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
    177269
    178     CALL report(routine, "ERROR: " // TRIM(message) // " Stopping.")
     270    CALL report( routine, "ERROR: " // TRIM( message ) // " Stopping." )
     271    CALL report_warnings
    179272    CALL close_log
    180     STOP
     273    CALL EXIT(1)
    181274
    182275 END SUBROUTINE inifor_abort
    … …  
    185278 SUBROUTINE close_log()
    186279
    187     CLOSE(u)
     280    CLOSE( u )
    188281
    189282 END SUBROUTINE close_log
    … …  
    209302!> accumulates them in timing budgets.
    210303!------------------------------------------------------------------------------!
    211  SUBROUTINE log_runtime(mode, budget)
     304 SUBROUTINE log_runtime( mode, budget )
    212305
    213306    CHARACTER(LEN=*), INTENT(IN) ::  mode   !< name of the calling mode
    … …  
    226319
    227320
    228     SELECT CASE(TRIM(mode))
    229 
    230     CASE('init')
     321    SELECT CASE( TRIM( mode ) )
     322
     323    CASE( 'init' )
    231324       CALL CPU_TIME(t0)
    232325
    233     CASE('time')
     326    CASE( 'time' )
    234327
    235328       CALL CPU_TIME(t1)
    236329
    237        SELECT CASE(TRIM(budget))
    238 
    239           CASE('alloc')
     330       SELECT CASE( TRIM( budget ) )
     331
     332          CASE( 'alloc' )
    240333             t_alloc = t_alloc + t1 - t0
    241334
    242           CASE('init')
     335          CASE( 'init' )
    243336             t_init = t_init + t1 - t0
    244337
    245           CASE('read')
     338          CASE( 'read' )
    246339             t_read = t_read + t1 - t0
    247340
    248           CASE('write')
     341          CASE( 'write' )
    249342             t_write = t_write + t1 - t0
    250343
    251           CASE('comp')
     344          CASE( 'comp' )
    252345             t_comp = t_comp + t1 - t0
    253346
    254347          CASE DEFAULT
    255              CALL inifor_abort('log_runtime', "Time Budget '" // TRIM(mode) // "' is not supported.")
     348             CALL inifor_abort(                                                &
     349                'log_runtime',                                                 &
     350                "Time Budget '" // TRIM( mode ) // "' is not supported."       &
     351             )
    256352
    257353       END SELECT
    … …  
    259355       t0 = t1
    260356
    261     CASE('report')
     357    CASE( 'report' )
    262358        t_total = t_init + t_read + t_write + t_comp
    263359
    264         CALL report('log_runtime', " *** CPU time ***")
    265 
    266         CALL report('log_runtime', "Initialization:  " // TRIM( real_to_str( t_init ) ) // &
    267                     " s  (" // TRIM( real_to_str( 100 * t_init / t_total, fmt ) ) // " %)" )
    268 
    269         CALL report('log_runtime', "(De-)Allocation: " // TRIM( real_to_str( t_alloc ) ) // &
    270                     " s  (" // TRIM( real_to_str( 100 * t_alloc / t_total, fmt ) ) // " %)" )
    271 
    272         CALL report('log_runtime', "Reading data:    " // TRIM( real_to_str( t_read ) )  // &
    273                     " s  (" // TRIM( real_to_str( 100 * t_read / t_total, fmt ) ) // " %)" )
    274 
    275         CALL report('log_runtime', "Writing data:    " // TRIM( real_to_str( t_write ) ) // &
    276                     " s  (" // TRIM( real_to_str( 100 * t_write / t_total, fmt ) ) // " %)" )
    277 
    278         CALL report('log_runtime', "Computation:     " // TRIM( real_to_str( t_comp ) )  // &
    279                     " s  (" // TRIM( real_to_str( 100 * t_comp / t_total, fmt) ) // " %)" )
    280 
    281         CALL report('log_runtime', "Total:           " // TRIM( real_to_str( t_total ) ) // &
    282                     " s  (" // TRIM( real_to_str( 100 * t_total / t_total, fmt ) ) // " %)")
     360        CALL report( 'log_runtime', "*** CPU time ***" )
     361
     362        CALL report( 'log_runtime', "Initialization:  " // TRIM( real_to_str( t_init ) ) // &
     363                     " s  (" // TRIM( real_to_str( 100 * t_init / t_total, fmt ) ) // " %)" )
     364
     365        CALL report( 'log_runtime', "(De-)Allocation: " // TRIM( real_to_str( t_alloc ) ) // &
     366                     " s  (" // TRIM( real_to_str( 100 * t_alloc / t_total, fmt ) ) // " %)" )
     367
     368        CALL report( 'log_runtime', "Reading data:    " // TRIM( real_to_str( t_read ) )  // &
     369                     " s  (" // TRIM( real_to_str( 100 * t_read / t_total, fmt ) ) // " %)" )
     370
     371        CALL report( 'log_runtime', "Writing data:    " // TRIM( real_to_str( t_write ) ) // &
     372                     " s  (" // TRIM( real_to_str( 100 * t_write / t_total, fmt ) ) // " %)" )
     373
     374        CALL report( 'log_runtime', "Computation:     " // TRIM( real_to_str( t_comp ) )  // &
     375                     " s  (" // TRIM( real_to_str( 100 * t_comp / t_total, fmt) ) // " %)" )
     376
     377        CALL report( 'log_runtime', "Total:           " // TRIM( real_to_str( t_total ) ) // &
     378                     " s  (" // TRIM( real_to_str( 100 * t_total / t_total, fmt ) ) // " %)" )
    283379
    284380    CASE DEFAULT
    285        CALL inifor_abort('log_runtime', "Mode '" // TRIM(mode) // "' is not supported.")
     381       CALL inifor_abort( 'log_runtime', "Mode '" // TRIM(mode) // "' is not supported." )
    286382
    287383    END SELECT
    … …  
    289385 END SUBROUTINE log_runtime
    290386
     387
    291388 END MODULE inifor_control
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |