Changeset 4578 for palm/trunk/SOURCE/message.f90

Timestamp:

Jun 25, 2020 3:43:32 PM (4 years ago)

Author:

gronemeier

Message:

message.f90:

• bugfix : do not save input values from last call of routines debug_message and location_message
• changes: layout changes according to PALM coding standards

time_integration.f90:

• bugfix: removed unused variables

File:

• palm/trunk/SOURCE/message.f90 (modified) (13 diffs)

palm/trunk/SOURCE/message.f90

@@ -20 +20 @@
 ! Current revisions:
 ! -----------------
-! 
-! 
+!
+!
 ! Former revisions:
 ! -----------------
 ! $Id$
+! bugfix : do not save input values from last call of routines debug_message and location_message
+! changes: layout changes according to PALM coding standards
+!
+! 4536 2020-05-17 17:24:13Z raasch
 ! location message format changed
-! 
+!
 ! 4360 2020-01-07 11:25:50Z suehring
 ! Corrected "Former revisions" section
-! 
+!
 ! 4097 2019-07-15 11:59:11Z suehring
 ! Avoid overlong lines - limit is 132 characters per line
-! 
+!
 ! 3987 2019-05-22 09:52:13Z kanani
 ! Improved formatting of job logfile output,
 ! changed output of DEBUG file
-! 
+!
 ! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction 
+! Changes related to global restructuring of location messages and introduction
 ! of additional debug messages
-! 
+!
 ! 3655 2019-01-07 16:51:22Z knoop
 ! Minor formating changes
@@ -60 +64 @@
  SUBROUTINE message( routine_name, message_identifier, requested_action, &
                      message_level, output_on_pe, file_id, flush_file )
- 
+
     USE control_parameters,                                                    &
         ONLY:  abort_mode, message_string
@@ -121 +125 @@
     header_string_2 = 'ID: ' // message_identifier // &
                       '  generated by routine: ' // TRIM( routine_name )
-  
+
     information_string_1 = 'Further information can be found at'
     IF(message_identifier(1:2) == 'NC') THEN
@@ -130 +134 @@
                               '/app/errmsg#' // message_identifier
     ENDIF
-    
+
 
 !
@@ -173 +177 @@
           WRITE( *, '(20X,A)' )  TRIM( message_string )
           WRITE( *, '(20X,A)' )  ''
-          WRITE( *, '(20X,A)' )  TRIM( information_string_1 ) 
-          WRITE( *, '(20X,A)' )  TRIM( information_string_2 ) 
+          WRITE( *, '(20X,A)' )  TRIM( information_string_1 )
+          WRITE( *, '(20X,A)' )  TRIM( information_string_2 )
           WRITE( *, '(20X,A)' )  ''
 
@@ -193 +197 @@
           WRITE( file_id, '(4X,A)' )  TRIM( message_string )
           WRITE( file_id, '(4X,A)' )  ''
-          WRITE( file_id, '(4X,A)' )  TRIM( information_string_1 ) 
-          WRITE( file_id, '(4X,A)' )  TRIM( information_string_2 ) 
+          WRITE( file_id, '(4X,A)' )  TRIM( information_string_1 )
+          WRITE( file_id, '(4X,A)' )  TRIM( information_string_2 )
           WRITE( file_id, '(4X,A)' )  ''
 !
@@ -227 +231 @@
 !> Prints out the given location on stdout
 !--------------------------------------------------------------------------------------------------!
- 
  SUBROUTINE location_message( location, message_type )
-
 
     USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                                            &
         ONLY:  OUTPUT_UNIT
 
-    USE pegrid
+    USE pegrid,                                                                                    &
+        ONLY:  myid
 
     USE pmc_interface,                                                                             &
@@ -241 +244 @@
     IMPLICIT NONE
 
-    CHARACTER(LEN=*)  ::  location      !< text to be output on stdout
-    CHARACTER(LEN=60) ::  location_string = ' '  !<
-    CHARACTER(LEN=*)  ::  message_type  !< attribute marking 'start' or 'end' of routine
-    CHARACTER(LEN=11) ::  message_type_string = ' '  !< 
-    CHARACTER(LEN=10) ::  system_time   !< system clock time
-    CHARACTER(LEN=10) ::  time
+    CHARACTER(LEN=*)  ::  location             !< text to be output on stdout
+    CHARACTER(LEN=60) ::  location_trimmed     !< trimmed text to be output on stdout
+    CHARACTER(LEN=*)  ::  message_type         !< type of message; supported values: 'start', 'finished'
+    CHARACTER(LEN=10) ::  message_type_string  !< formatted message-type string for output
+    CHARACTER(LEN=8)  ::  system_time          !< formatted system clock time
+    CHARACTER(LEN=10) ::  time                 !< current time of system
+
 !
 !-- Output for nested runs only on the root domain
@@ -254 +258 @@
 !
 !--    Get system time for debug info output (helpful to estimate the required computing time for
-!--    specific parts of code
+!--    specific parts of code)
        CALL date_and_time( TIME=time )
-       system_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
-!
-!--    Write pre-string depending on message_type
-       IF ( TRIM( message_type ) == 'start' )     WRITE( message_type_string, * ) '-', TRIM( message_type ), '----'
-       IF ( TRIM( message_type ) == 'finished' )  WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
-!
-!--    Write dummy location_string in order to allow left-alignment of text despite the fixed (=A60)
-!--    format.
-       WRITE( location_string, * )  TRIM( location )
+       system_time = time(1:2) // ':' // time(3:4) // ':' // time(5:6)
+!
+!--    Write message-type string depending on message_type
+       message_type_string = REPEAT( '-', 10 )
+       IF ( TRIM( message_type ) == 'start' )                                                      &
+          message_type_string(2:) = TRIM( message_type ) // '----'
+       IF ( TRIM( message_type ) == 'finished' )                                                   &
+          message_type_string(2:) = TRIM( message_type ) // '-'
+!
+!--    Trim location text to a maximum of 60 chars
+!--    Note: if the length is set within the write format, the string is right-aligned; to trim and
+!--    left-align the output, we need to use this detour
+       WRITE( location_trimmed, '(A)' )  ADJUSTL( TRIM( location ) )
 !
 !--    Write and flush debug location or info message to file
-       WRITE( OUTPUT_UNIT, 200 )  TRIM( system_time ), TRIM( message_type_string ),                &
-                                  TRIM( location_string )
+       WRITE( OUTPUT_UNIT, 200 )  system_time, message_type_string, TRIM( location_trimmed )
        FLUSH( OUTPUT_UNIT )
 !
 !--    Message formats
-200    FORMAT ( 3X, A, 3x, A, 2X, A )
+200    FORMAT ( 3X, A, 3x, A, 3X, A )
 
     ENDIF
@@ -285 +292 @@
 !> for each PE on each domain.
 !--------------------------------------------------------------------------------------------------!
-
  SUBROUTINE debug_message( debug_string, message_type )
-
 
     USE control_parameters,                                                                        &
@@ -294 +299 @@
     IMPLICIT NONE
 
-
-    CHARACTER(LEN=*)   ::  debug_string        !< debug message to be output on unit 9
-    CHARACTER(LEN=*)   ::  message_type        !< 'start', 'end', 'info'
-    CHARACTER(LEN=10)  ::  message_type_string = ' '  !< 
-    CHARACTER(LEN=10)  ::  system_time         !< system clock time
-    CHARACTER(LEN=10)  ::  time
+    CHARACTER(LEN=*)  ::  debug_string         !< debug message to be output to debug_output_unit
+    CHARACTER(LEN=*)  ::  message_type         !< type of message; supported values: 'start', 'end', 'info'
+    CHARACTER(LEN=7)  ::  message_type_string  !< formatted message-type string for output
+    CHARACTER(LEN=8)  ::  system_time          !< formatted system clock time
+    CHARACTER(LEN=10) ::  time                 !< current time of system
 
     INTEGER, PARAMETER ::  debug_output_unit = 9
@@ -305 +309 @@
 !
 !-- Get system time for debug info output (helpful to estimate the required computing time for
-!-- specific parts of code
+!-- specific parts of code)
     CALL date_and_time( TIME=time )
-    system_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
-!
-!-- Write pre-string depending on message_type
-    IF ( TRIM( message_type ) == 'start' )  WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
-    IF ( TRIM( message_type ) == 'end' )    WRITE( message_type_string, * ) '-', TRIM( message_type ), '---'
-    IF ( TRIM( message_type ) == 'info' )   WRITE( message_type_string, * ) '-', TRIM( message_type ), '--'
+    system_time = time(1:2) // ':' // time(3:4) // ':' // time(5:6)
+!
+!-- Write message-type string depending on message_type
+    message_type_string = REPEAT( '-', 7 )
+    IF ( TRIM( message_type ) == 'start' )  message_type_string(2:) = TRIM( message_type ) // '-'
+    IF ( TRIM( message_type ) == 'end' )    message_type_string(2:) = TRIM( message_type ) // '---'
+    IF ( TRIM( message_type ) == 'info' )   message_type_string(2:) = TRIM( message_type ) // '--'
 !
 !-- Write and flush debug location or info message to file
-    WRITE( debug_output_unit, 201 )    TRIM( system_time ), time_since_reference_point, &
-                                       TRIM( message_type_string ), TRIM( debug_string )
+    WRITE( debug_output_unit, 201 )    system_time, time_since_reference_point, &
+                                       message_type_string, TRIM( debug_string )
     FLUSH( debug_output_unit )
-
 !
 !-- Message formats
 201 FORMAT ( 'System time: ', A, ' | simulated time (s): ', F12.3, ' | ', A, ' ', A )
-
 
  END SUBROUTINE debug_message
@@ -332 +335 @@
 !> Abort routine for failures durin reading of namelists
 !------------------------------------------------------------------------------!
- 
  SUBROUTINE parin_fail_message( location, line )