Ignore:
Timestamp:
Apr 11, 2019 11:29:34 AM (2 years ago)
Author:
kanani
Message:

restructure/add location/debug messages

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/message.f90

    r3655 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3655 2019-01-07 16:51:22Z knoop
    2731! Minor formating changes
    2832!
     
    199203!
    200204!--       Output on stdout
    201           WRITE( *, '(//A/)' )  TRIM( header_string )
     205          WRITE( *, '(6X,A)' )  TRIM( header_string )
    202206!
    203207!--       Cut message string into pieces and output one piece per line.
     
    210214             i = INDEX( message_string, '&' )
    211215          ENDDO
    212           WRITE( *, '(4X,A)' )  TRIM( message_string )
    213           WRITE( *, '(4X,A)' )  ''
    214           WRITE( *, '(4X,A)' )  TRIM( information_string_1 )
    215           WRITE( *, '(4X,A)' )  TRIM( information_string_2 )
    216           WRITE( *, '(4X,A)' )  ''
     216          WRITE( *, '(10X,A)' )  ''
     217          WRITE( *, '(10X,A)' )  TRIM( message_string )
     218          WRITE( *, '(10X,A)' )  ''
     219          WRITE( *, '(10X,A)' )  TRIM( information_string_1 )
     220          WRITE( *, '(10X,A)' )  TRIM( information_string_2 )
     221          WRITE( *, '(10X,A)' )  ''
    217222
    218223       ELSE
     
    261266
    262267
    263 !------------------------------------------------------------------------------!
     268!--------------------------------------------------------------------------------------------------!
    264269! Description:
    265270! ------------
    266271!> Prints out the given location on stdout
    267 !------------------------------------------------------------------------------!
     272!--------------------------------------------------------------------------------------------------!
    268273 
    269  SUBROUTINE location_message( location, advance )
    270 
    271 
    272     USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                        &
     274 SUBROUTINE location_message( location, message_type )
     275
     276
     277    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                                            &
    273278        ONLY:  OUTPUT_UNIT
    274279
    275280    USE pegrid
    276281
    277     USE pmc_interface,                                                         &
     282    USE pmc_interface,                                                                             &
    278283        ONLY:  cpl_id
    279284
    280285    IMPLICIT NONE
    281286
    282     CHARACTER(LEN=*) ::  location !< text to be output on stdout
    283     LOGICAL          ::  advance  !< switch for advancing/noadvancing I/O
    284 
     287    CHARACTER(LEN=*)  ::  location      !< text to be output on stdout
     288    CHARACTER(LEN=*)  ::  message_type  !< attribute marking 'start' or 'end' of routine
     289    CHARACTER(LEN=11) ::  message_type_string = ' '  !<
     290    CHARACTER(LEN=10) ::  system_time   !< system clock time
     291    CHARACTER(LEN=10) ::  time
    285292!
    286293!-- Output for nested runs only on the root domain
     
    288295
    289296    IF ( myid == 0 )  THEN
    290        IF ( advance )  THEN
    291           WRITE ( OUTPUT_UNIT, '(6X,''--- '',A)' )  TRIM( location )
    292        ELSE
    293           WRITE ( OUTPUT_UNIT, '(6X,''... '',A)', ADVANCE='NO' )               &
    294                 TRIM( location )
    295        ENDIF
     297!
     298!--    Get system time for debug info output (helpful to estimate the required computing time for
     299!--    specific parts of code
     300       CALL date_and_time( TIME=time )
     301       system_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
     302!
     303!--    Write pre-string depending on message_type
     304       IF ( TRIM( message_type ) == 'start' )     WRITE( message_type_string, * ) '-', TRIM( message_type ), '----'
     305       IF ( TRIM( message_type ) == 'finished' )  WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
     306!
     307!--    Write and flush debug location or info message to file
     308       WRITE( OUTPUT_UNIT, 200 )  TRIM( message_type_string ), TRIM( location ), TRIM( system_time )
    296309       FLUSH( OUTPUT_UNIT )
     310!
     311!--    Message formats
     312200    FORMAT ( 3X, A, '  ', A, '  | System time: ', A )
     313
    297314    ENDIF
    298315
    299316 END SUBROUTINE location_message
     317
     318
     319!--------------------------------------------------------------------------------------------------!
     320! Description:
     321! ------------
     322!> Prints out the given debug information to unit 9 (DEBUG files in temporary directory)
     323!> for each PE on each domain.
     324!--------------------------------------------------------------------------------------------------!
     325
     326 SUBROUTINE debug_message( debug_string, message_type )
     327
     328
     329    USE control_parameters,                                                                        &
     330        ONLY:  current_timestep_number
     331
     332    IMPLICIT NONE
     333
     334
     335    CHARACTER(LEN=*)   ::  debug_string        !< debug message to be output on unit 9
     336    CHARACTER(LEN=*)   ::  message_type        !< 'start', 'end', 'info'
     337    CHARACTER(LEN=10)  ::  message_type_string = ' '  !<
     338    CHARACTER(LEN=10)  ::  system_time         !< system clock time
     339    CHARACTER(LEN=10)  ::  time
     340
     341    INTEGER, PARAMETER ::  debug_output_unit = 9
     342
     343!
     344!-- Get system time for debug info output (helpful to estimate the required computing time for
     345!-- specific parts of code
     346    CALL date_and_time( TIME=time )
     347    system_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
     348!
     349!-- Write pre-string depending on message_type
     350    IF ( TRIM( message_type ) == 'start' )  WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
     351    IF ( TRIM( message_type ) == 'end' )    WRITE( message_type_string, * ) '-', TRIM( message_type ), '---'
     352    IF ( TRIM( message_type ) == 'info' )   WRITE( message_type_string, * ) '-', TRIM( message_type ), '--'
     353!
     354!-- Write and flush debug location or info message to file
     355    WRITE( debug_output_unit, 201 )    TRIM( system_time ), current_timestep_number, TRIM( message_type_string ), TRIM( debug_string )
     356    FLUSH( debug_output_unit )
     357
     358!
     359!-- Message formats
     360201 FORMAT ( 'System time: ', A, ' | timestep: ', I6, ' | ', A, ' ', A )
     361
     362
     363 END SUBROUTINE debug_message
    300364
    301365
Note: See TracChangeset for help on using the changeset viewer.