Ignore:
Timestamp:
Apr 5, 2019 2:25:01 PM (3 years ago)
Author:
eckhard
Message:

inifor: Use PALM's working precision; improved error handling, coding style, and comments

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/UTIL/inifor/src/inifor_control.f90

    r3785 r3866  
    2626! -----------------
    2727! $Id$
     28! Use PALM's working precision
     29! Renamed run_control -> log_runtime
     30! Open log file only once
     31! Improved coding style
     32!
     33!
     34! 3785 2019-03-06 10:41:14Z eckhard
    2835! Added message buffer for displaying tips to rectify encountered errors
    2936!
     
    6673!> feedback to the terminal and a log file.
    6774!------------------------------------------------------------------------------!
    68 #if defined ( __netcdf )
    6975 MODULE inifor_control
    7076
    7177    USE inifor_defs,                                                           &
    72         ONLY:  LNAME, dp, VERSION, COPYRIGHT
    73 
     78        ONLY:  COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, wp
    7479    USE inifor_util,                                                           &
    7580        ONLY:  real_to_str, real_to_str_f
     
    7984    CHARACTER (LEN=5000) ::  message = '' !< log message buffer
    8085    CHARACTER (LEN=5000) ::  tip     = '' !< optional log message buffer for tips on how to rectify encountered errors
     86    INTEGER, SAVE        ::  u            !< Fortran file unit for the log file
    8187
    8288 CONTAINS
     
    94100!> to it.
    95101!------------------------------------------------------------------------------!
    96     SUBROUTINE report(routine, message, debug)
    97 
    98        CHARACTER(LEN=*), INTENT(IN)  ::  routine !< name of calling subroutine of function
    99        CHARACTER(LEN=*), INTENT(IN)  ::  message !< log message
    100        LOGICAL, OPTIONAL, INTENT(IN) ::  debug   !< flag the current message as debugging message
    101 
    102        INTEGER                       ::  u                     !< Fortran file unit for the log file
    103        LOGICAL, SAVE                 ::  is_first_run = .TRUE. !< control flag for file opening mode
    104        LOGICAL                       ::  suppress_message      !< control falg for additional debugging log
    105 
    106 
    107        IF ( is_first_run )  THEN
    108           OPEN( NEWUNIT=u, FILE='inifor.log', STATUS='replace' )
    109           is_first_run = .FALSE.
    110        ELSE
    111           OPEN( NEWUNIT=u, FILE='inifor.log', POSITION='append', STATUS='old' )
    112        ENDIF
    113          
    114 
    115        suppress_message = .FALSE.
    116        IF ( PRESENT(debug) )  THEN
    117           IF ( .NOT. debug )  suppress_message = .TRUE.
    118        ENDIF
    119 
    120        IF ( .NOT. suppress_message )  THEN
    121           PRINT *, "inifor: " // TRIM(message) // "  [ " // TRIM(routine) // " ]"
    122           WRITE(u, *)  TRIM(message) // "  [ " // TRIM(routine) // " ]"
    123        ENDIF
    124 
    125        CLOSE(u)
    126 
    127     END SUBROUTINE report
     102 SUBROUTINE report(routine, message, debug)
     103
     104    CHARACTER(LEN=*), INTENT(IN)  ::  routine !< name of calling subroutine of function
     105    CHARACTER(LEN=*), INTENT(IN)  ::  message !< log message
     106    LOGICAL, OPTIONAL, INTENT(IN) ::  debug   !< flag the current message as debugging message
     107
     108    LOGICAL, SAVE                 ::  is_first_run = .TRUE. !< control flag for file opening mode
     109    LOGICAL                       ::  suppress_message      !< control falg for additional debugging log
     110
     111    IF ( is_first_run )  THEN
     112       OPEN( NEWUNIT=u, FILE=LOG_FILE_NAME, STATUS='replace' )
     113       is_first_run = .FALSE.
     114    ENDIF
     115       
     116
     117    suppress_message = .FALSE.
     118    IF ( PRESENT(debug) )  THEN
     119       IF ( .NOT. debug )  suppress_message = .TRUE.
     120    ENDIF
     121
     122    IF ( .NOT. suppress_message )  THEN
     123       PRINT *, "inifor: " // TRIM(message) // "  [ " // TRIM(routine) // " ]"
     124       WRITE(u, *)  TRIM(message) // "  [ " // TRIM(routine) // " ]"
     125    ENDIF
     126
     127 END SUBROUTINE report
    128128
    129129
     
    138138!> continue.
    139139!------------------------------------------------------------------------------!
    140     SUBROUTINE warn(routine, message)
    141 
    142        CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
    143        CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
    144 
    145        CALL report(routine, "WARNING: " // TRIM(message))
    146 
    147     END SUBROUTINE warn
     140 SUBROUTINE warn(routine, message)
     141
     142    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
     143    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
     144
     145    CALL report(routine, "WARNING: " // TRIM(message))
     146
     147 END SUBROUTINE warn
    148148
    149149
     
    158158!> INIFOR from continueing.
    159159!------------------------------------------------------------------------------!
    160     SUBROUTINE inifor_abort(routine, message)
    161 
    162        CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
    163        CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
    164 
    165        CALL report(routine, "ERROR: " // TRIM(message) // " Stopping.")
    166        STOP
    167 
    168     END SUBROUTINE inifor_abort
     160 SUBROUTINE inifor_abort(routine, message)
     161
     162    CHARACTER(LEN=*), INTENT(IN) ::  routine !< name of calling subroutine or function
     163    CHARACTER(LEN=*), INTENT(IN) ::  message !< log message
     164
     165    CALL report(routine, "ERROR: " // TRIM(message) // " Stopping.")
     166    CALL close_log
     167    STOP
     168
     169 END SUBROUTINE inifor_abort
     170
     171
     172 SUBROUTINE close_log()
     173
     174    CLOSE(u)
     175
     176 END SUBROUTINE close_log
    169177
    170178
     
    175183!> print_version() prints the INIFOR version number and copyright notice.
    176184!------------------------------------------------------------------------------!
    177     SUBROUTINE print_version()
    178        PRINT *, "INIFOR " // VERSION
    179        PRINT *, COPYRIGHT
    180     END SUBROUTINE print_version
    181 
    182 
    183 !------------------------------------------------------------------------------!
    184 ! Description:
    185 ! ------------
    186 !>
    187 !> run_control() measures the run times of various parts of INIFOR and
     185 SUBROUTINE print_version()
     186    PRINT *, "INIFOR " // VERSION
     187    PRINT *, COPYRIGHT
     188 END SUBROUTINE print_version
     189
     190
     191!------------------------------------------------------------------------------!
     192! Description:
     193! ------------
     194!>
     195!> log_runtime() measures the run times of various parts of INIFOR and
    188196!> accumulates them in timing budgets.
    189197!------------------------------------------------------------------------------!
    190     SUBROUTINE run_control(mode, budget)
    191 
    192        CHARACTER(LEN=*), INTENT(IN) ::  mode   !< name of the calling mode
    193        CHARACTER(LEN=*), INTENT(IN) ::  budget !< name of the timing budget
    194 
    195        REAL(dp), SAVE ::  t0               !< begin of timing interval
    196        REAL(dp), SAVE ::  t1               !< end of timing interval
    197        REAL(dp), SAVE ::  t_comp  = 0.0_dp !< computation timing budget
    198        REAL(dp), SAVE ::  t_alloc = 0.0_dp !< allocation timing budget
    199        REAL(dp), SAVE ::  t_init  = 0.0_dp !< initialization timing budget
    200        REAL(dp), SAVE ::  t_read  = 0.0_dp !< reading timing budget
    201        REAL(dp), SAVE ::  t_total = 0.0_dp !< total time
    202        REAL(dp), SAVE ::  t_write = 0.0_dp !< writing timing budget
    203 
    204        CHARACTER(LEN=*), PARAMETER  ::  fmt='(F6.2)' !< floating-point output format
    205 
    206 
    207        SELECT CASE(TRIM(mode))
    208 
    209        CASE('init')
    210           CALL CPU_TIME(t0)
    211 
    212        CASE('time')
    213 
    214           CALL CPU_TIME(t1)
    215 
    216           SELECT CASE(TRIM(budget))
    217 
    218              CASE('alloc')
    219                 t_alloc = t_alloc + t1 - t0
    220 
    221              CASE('init')
    222                 t_init = t_init + t1 - t0
    223 
    224              CASE('read')
    225                 t_read = t_read + t1 - t0
    226 
    227              CASE('write')
    228                 t_write = t_write + t1 - t0
    229 
    230              CASE('comp')
    231                 t_comp = t_comp + t1 - t0
    232 
    233              CASE DEFAULT
    234                 CALL inifor_abort('run_control', "Time Budget '" // TRIM(mode) // "' is not supported.")
    235 
    236           END SELECT
    237 
    238           t0 = t1
    239 
    240        CASE('report')
    241            t_total = t_init + t_read + t_write + t_comp
    242 
    243            CALL report('run_control', " *** CPU time ***")
    244 
    245            CALL report('run_control', "Initialization: " // real_to_str(t_init)  // &
    246                        " s (" // TRIM(real_to_str(100*t_init/t_total, fmt))      // " %)")
    247 
    248            CALL report('run_control', "(De-)Allocation:" // real_to_str(t_alloc)  // &
    249                        " s (" // TRIM(real_to_str(100*t_alloc/t_total, fmt))      // " %)")
    250 
    251            CALL report('run_control', "Reading data:   " // real_to_str(t_read)  // &
    252                        " s (" // TRIM(real_to_str(100*t_read/t_total, fmt))      // " %)")
    253 
    254            CALL report('run_control', "Writing data:   " // real_to_str(t_write) // &
    255                        " s (" // TRIM(real_to_str(100*t_write/t_total, fmt))     // " %)")
    256 
    257            CALL report('run_control', "Computation:    " // real_to_str(t_comp)  // &
    258                        " s (" // TRIM(real_to_str(100*t_comp/t_total, fmt))      // " %)")
    259 
    260            CALL report('run_control', "Total:          " // real_to_str(t_total) // &
    261                        " s (" // TRIM(real_to_str(100*t_total/t_total, fmt))     // " %)")
    262 
    263        CASE DEFAULT
    264           CALL inifor_abort('run_control', "Mode '" // TRIM(mode) // "' is not supported.")
     198 SUBROUTINE log_runtime(mode, budget)
     199
     200    CHARACTER(LEN=*), INTENT(IN) ::  mode   !< name of the calling mode
     201    CHARACTER(LEN=*), INTENT(IN) ::  budget !< name of the timing budget
     202
     203    REAL(wp), SAVE ::  t0               !< begin of timing interval
     204    REAL(wp), SAVE ::  t1               !< end of timing interval
     205    REAL(wp), SAVE ::  t_comp  = 0.0_wp !< computation timing budget
     206    REAL(wp), SAVE ::  t_alloc = 0.0_wp !< allocation timing budget
     207    REAL(wp), SAVE ::  t_init  = 0.0_wp !< initialization timing budget
     208    REAL(wp), SAVE ::  t_read  = 0.0_wp !< reading timing budget
     209    REAL(wp), SAVE ::  t_total = 0.0_wp !< total time
     210    REAL(wp), SAVE ::  t_write = 0.0_wp !< writing timing budget
     211
     212    CHARACTER(LEN=*), PARAMETER  ::  fmt='(F6.2)' !< floating-point output format
     213
     214
     215    SELECT CASE(TRIM(mode))
     216
     217    CASE('init')
     218       CALL CPU_TIME(t0)
     219
     220    CASE('time')
     221
     222       CALL CPU_TIME(t1)
     223
     224       SELECT CASE(TRIM(budget))
     225
     226          CASE('alloc')
     227             t_alloc = t_alloc + t1 - t0
     228
     229          CASE('init')
     230             t_init = t_init + t1 - t0
     231
     232          CASE('read')
     233             t_read = t_read + t1 - t0
     234
     235          CASE('write')
     236             t_write = t_write + t1 - t0
     237
     238          CASE('comp')
     239             t_comp = t_comp + t1 - t0
     240
     241          CASE DEFAULT
     242             CALL inifor_abort('log_runtime', "Time Budget '" // TRIM(mode) // "' is not supported.")
    265243
    266244       END SELECT
    267245
    268     END SUBROUTINE run_control
     246       t0 = t1
     247
     248    CASE('report')
     249        t_total = t_init + t_read + t_write + t_comp
     250
     251        CALL report('log_runtime', " *** CPU time ***")
     252
     253        CALL report('log_runtime', "Initialization:  " // TRIM( real_to_str( t_init ) ) // &
     254                    " s  (" // TRIM( real_to_str( 100 * t_init / t_total, fmt ) ) // " %)" )
     255
     256        CALL report('log_runtime', "(De-)Allocation: " // TRIM( real_to_str( t_alloc ) ) // &
     257                    " s  (" // TRIM( real_to_str( 100 * t_alloc / t_total, fmt ) ) // " %)" )
     258
     259        CALL report('log_runtime', "Reading data:    " // TRIM( real_to_str( t_read ) )  // &
     260                    " s  (" // TRIM( real_to_str( 100 * t_read / t_total, fmt ) ) // " %)" )
     261
     262        CALL report('log_runtime', "Writing data:    " // TRIM( real_to_str( t_write ) ) // &
     263                    " s  (" // TRIM( real_to_str( 100 * t_write / t_total, fmt ) ) // " %)" )
     264
     265        CALL report('log_runtime', "Computation:     " // TRIM( real_to_str( t_comp ) )  // &
     266                    " s  (" // TRIM( real_to_str( 100 * t_comp / t_total, fmt) ) // " %)" )
     267
     268        CALL report('log_runtime', "Total:           " // TRIM( real_to_str( t_total ) ) // &
     269                    " s  (" // TRIM( real_to_str( 100 * t_total / t_total, fmt ) ) // " %)")
     270
     271    CASE DEFAULT
     272       CALL inifor_abort('log_runtime', "Mode '" // TRIM(mode) // "' is not supported.")
     273
     274    END SELECT
     275
     276 END SUBROUTINE log_runtime
    269277
    270278 END MODULE inifor_control
    271 #endif
    272 
Note: See TracChangeset for help on using the changeset viewer.