Ignore:
Timestamp:
May 22, 2019 9:52:13 AM (5 years ago)
Author:
kanani
Message:

clean up location, debug and error messages

File:
1 edited

Legend:

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

    r3956 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3956 2019-05-07 12:32:52Z monakurppa
    2730! Removed salsa calls.
    2831!
     
    409412    USE control_parameters,                                                    &
    410413        ONLY:  constant_diffusion,                                             &
    411                debug_output, debug_string,                                     &
     414               debug_output_timestep,                                          &
    412415               dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d,    &
    413416               humidity, intermediate_timestep_count,                          &
     
    523526
    524527
    525 
    526     IF ( debug_output )  THEN
    527        WRITE( debug_string, * ) 'prognostic_equations_cache'
    528        CALL debug_message( debug_string, 'start' )
    529     ENDIF
     528    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'start' )
    530529!
    531530!-- Time measurement can only be performed for the whole set of equations
     
    10711070    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
    10721071
    1073     IF ( debug_output )  THEN
    1074        WRITE( debug_string, * ) 'prognostic_equations_cache'
    1075        CALL debug_message( debug_string, 'end' )
    1076     ENDIF
     1072    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'end' )
    10771073
    10781074 END SUBROUTINE prognostic_equations_cache
     
    10951091
    10961092
    1097     IF ( debug_output )  THEN
    1098        WRITE( debug_string, * ) 'prognostic_equations_vector'
    1099        CALL debug_message( debug_string, 'start' )
    1100     ENDIF
     1093    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'start' )
    11011094!
    11021095!-- Calculate non advective processes for all other modules
     
    17831776    CALL module_interface_prognostic_equations()
    17841777
    1785     IF ( debug_output )  THEN
    1786        WRITE( debug_string, * ) 'prognostic_equations_vector'
    1787        CALL debug_message( debug_string, 'end' )
    1788     ENDIF
     1778    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'end' )
    17891779
    17901780 END SUBROUTINE prognostic_equations_vector
Note: See TracChangeset for help on using the changeset viewer.