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

Timestamp:

Apr 11, 2019 11:29:34 AM (5 years ago)

Author:

kanani

Message:

restructure/add location/debug messages

File:

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

palm/trunk/SOURCE/message.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! 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
 ! 
@@ -199 +203 @@
 !
 !--       Output on stdout
-          WRITE( *, '(//A/)' )  TRIM( header_string )
+          WRITE( *, '(6X,A)' )  TRIM( header_string )
 !
 !--       Cut message string into pieces and output one piece per line.
@@ -210 +214 @@
              i = INDEX( message_string, '&' )
           ENDDO
-          WRITE( *, '(4X,A)' )  TRIM( message_string )
-          WRITE( *, '(4X,A)' )  ''
-          WRITE( *, '(4X,A)' )  TRIM( information_string_1 ) 
-          WRITE( *, '(4X,A)' )  TRIM( information_string_2 ) 
-          WRITE( *, '(4X,A)' )  ''
+          WRITE( *, '(10X,A)' )  ''
+          WRITE( *, '(10X,A)' )  TRIM( message_string )
+          WRITE( *, '(10X,A)' )  ''
+          WRITE( *, '(10X,A)' )  TRIM( information_string_1 ) 
+          WRITE( *, '(10X,A)' )  TRIM( information_string_2 ) 
+          WRITE( *, '(10X,A)' )  ''
 
        ELSE
@@ -261 +266 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Prints out the given location on stdout
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  
- SUBROUTINE location_message( location, advance )
-
-
-    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                        &
+ SUBROUTINE location_message( location, message_type )
+
+
+    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                                            &
         ONLY:  OUTPUT_UNIT
 
     USE pegrid
 
-    USE pmc_interface,                                                         &
+    USE pmc_interface,                                                                             &
         ONLY:  cpl_id
 
     IMPLICIT NONE
 
-    CHARACTER(LEN=*) ::  location !< text to be output on stdout
-    LOGICAL          ::  advance  !< switch for advancing/noadvancing I/O
-
+    CHARACTER(LEN=*)  ::  location      !< text to be output on stdout
+    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
 !
 !-- Output for nested runs only on the root domain
@@ -288 +295 @@
 
     IF ( myid == 0 )  THEN
-       IF ( advance )  THEN
-          WRITE ( OUTPUT_UNIT, '(6X,''--- '',A)' )  TRIM( location )
-       ELSE
-          WRITE ( OUTPUT_UNIT, '(6X,''... '',A)', ADVANCE='NO' )               &
-                TRIM( location )
-       ENDIF
+!
+!--    Get system time for debug info output (helpful to estimate the required computing time for
+!--    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 and flush debug location or info message to file
+       WRITE( OUTPUT_UNIT, 200 )  TRIM( message_type_string ), TRIM( location ), TRIM( system_time )
        FLUSH( OUTPUT_UNIT )
+!
+!--    Message formats
+200    FORMAT ( 3X, A, '  ', A, '  | System time: ', A )
+
     ENDIF
 
  END SUBROUTINE location_message
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Prints out the given debug information to unit 9 (DEBUG files in temporary directory)
+!> for each PE on each domain.
+!--------------------------------------------------------------------------------------------------!
+
+ SUBROUTINE debug_message( debug_string, message_type )
+
+
+    USE control_parameters,                                                                        &
+        ONLY:  current_timestep_number
+
+    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
+
+    INTEGER, PARAMETER ::  debug_output_unit = 9
+
+!
+!-- Get system time for debug info output (helpful to estimate the required computing time for
+!-- 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 ), '--'
+!
+!-- Write and flush debug location or info message to file
+    WRITE( debug_output_unit, 201 )    TRIM( system_time ), current_timestep_number, TRIM( message_type_string ), TRIM( debug_string )
+    FLUSH( debug_output_unit )
+
+!
+!-- Message formats
+201 FORMAT ( 'System time: ', A, ' | timestep: ', I6, ' | ', A, ' ', A )
+
+
+ END SUBROUTINE debug_message