Changeset 3866 for palm/trunk/UTIL/inifor/src/inifor_control.f90
- Timestamp:
- Apr 5, 2019 2:25:01 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/UTIL/inifor/src/inifor_control.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/inifor/src/inifor_control.f90
r3785 r3866 26 26 ! ----------------- 27 27 ! $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 28 35 ! Added message buffer for displaying tips to rectify encountered errors 29 36 ! … … 66 73 !> feedback to the terminal and a log file. 67 74 !------------------------------------------------------------------------------! 68 #if defined ( __netcdf )69 75 MODULE inifor_control 70 76 71 77 USE inifor_defs, & 72 ONLY: LNAME, dp, VERSION, COPYRIGHT 73 78 ONLY: COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, wp 74 79 USE inifor_util, & 75 80 ONLY: real_to_str, real_to_str_f … … 79 84 CHARACTER (LEN=5000) :: message = '' !< log message buffer 80 85 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 81 87 82 88 CONTAINS … … 94 100 !> to it. 95 101 !------------------------------------------------------------------------------! 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 128 128 129 129 … … 138 138 !> continue. 139 139 !------------------------------------------------------------------------------! 140 141 142 143 144 145 146 147 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 148 148 149 149 … … 158 158 !> INIFOR from continueing. 159 159 !------------------------------------------------------------------------------! 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 169 177 170 178 … … 175 183 !> print_version() prints the INIFOR version number and copyright notice. 176 184 !------------------------------------------------------------------------------! 177 178 179 180 181 182 183 !------------------------------------------------------------------------------! 184 ! Description: 185 ! ------------ 186 !> 187 !> run_control() measures the run times of various parts of INIFOR and185 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 188 196 !> accumulates them in timing budgets. 189 197 !------------------------------------------------------------------------------! 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.") 265 243 266 244 END SELECT 267 245 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 269 277 270 278 END MODULE inifor_control 271 #endif272
Note: See TracChangeset
for help on using the changeset viewer.
