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

restructure/add location/debug messages

File:
1 edited

Legend:

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

    r3880 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Karlsruhe Institute of Technology
    19 ! Copyright 2017-2018 Freie Universitaet Berlin
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Karlsruhe Institute of Technology
     19! Copyright 2017-2019 Freie Universitaet Berlin
    2020!------------------------------------------------------------------------------!
    2121!
     
    2727! -----------------
    2828! $Id: chemistry_model_mod.f90 3784 2019-03-05 14:16:20Z banzhafs
     29! Changes related to global restructuring of location messages and introduction
     30! of additional debug messages
     31!
     32! 3784 2019-03-05 14:16:20Z banzhafs
    2933! some formatting of the deposition code
    3034!
     
    310314
    311315    USE control_parameters,                                                                        &
    312          ONLY:  bc_lr_cyc, bc_ns_cyc, dt_3d, humidity, initializing_actions, message_string,       &
     316         ONLY:  bc_lr_cyc, bc_ns_cyc,                                                              &
     317                debug_output,                                                                      &
     318                dt_3d, humidity, initializing_actions, message_string,                             &
    313319         omega, tsc, intermediate_timestep_count, intermediate_timestep_count_max,                 &
    314320         max_pr_user, timestep_scheme, use_prescribed_profile_data, ws_scheme_sca, air_chemistry
     
    17551761    INTEGER(iwp) ::  j !< running index y dimension
    17561762    INTEGER(iwp) ::  n !< running index for chemical species
     1763
     1764
     1765    IF ( debug_output )  CALL debug_message( 'chem_init', 'start' )
    17571766!
    17581767!-- Next statement is to avoid compiler warning about unused variables
     
    17781787    ENDIF
    17791788
     1789    IF ( debug_output )  CALL debug_message( 'chem_init', 'end' )
    17801790
    17811791 END SUBROUTINE chem_init
     
    18821892!--    Initial profiles of the variables must be computed.
    18831893       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
    1884          CALL location_message( 'initializing with 1D chemistry model profiles', .FALSE. )
    18851894!
    18861895!--       Transfer initial profiles to the arrays of the 3D model
     
    18971906       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )    &
    18981907       THEN
    1899           CALL location_message( 'initializing with constant chemistry profiles', .FALSE. )
    19001908
    19011909          DO  lsp = 1, nspec
     
    22872295!       write(text,*) 'gas_phase chemistry: solver_type = ',TRIM( solver_type )
    22882296!kk    Has to be changed to right calling sequence
    2289 !kk       CALL location_message( TRIM( text ), .FALSE. )
    22902297!        IF(myid == 0)  THEN
    22912298!           write(9,*) ' '
Note: See TracChangeset for help on using the changeset viewer.