Changeset 3885 for palm/trunk


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

restructure/add location/debug messages

Location:
palm/trunk/SOURCE
Files:
33 edited

Legend:

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

    r3753 r3885  
    2727! -----------------
    2828! $Id$
     29! Changes related to global restructuring of location messages and introduction
     30! of additional debug messages
     31!
     32! 3753 2019-02-19 14:48:54Z dom_dwd_user
    2933! - Added automatic setting of mrt_nlevels in case it was not part of
    3034! radiation_parameters namelist (or set to 0 accidentially).
     
    150154
    151155    USE control_parameters,                                                    &
    152         ONLY:  average_count_3d, biometeorology, dz, dz_stretch_factor,        &
     156        ONLY:  average_count_3d, biometeorology,                               &
     157               debug_output,                                                   &
     158               dz, dz_stretch_factor,                                          &
    153159               dz_stretch_level, humidity, initializing_actions, nz_do3d,      &
    154160               surface_pressure
     
    12091215    REAL ( wp )  :: height  !< current height in meters
    12101216
    1211     CALL location_message( 'initializing biometeorology module', .FALSE. )
     1217    IF ( debug_output )  CALL debug_message( 'bio_init', 'start' )
    12121218!
    12131219!-- Determine cell level corresponding to 1.1 m above ground level
     
    12291235    IF ( uv_exposure )  CALL netcdf_data_input_uvem
    12301236
    1231     CALL location_message( 'finished', .TRUE. )
     1237    IF ( debug_output )  CALL debug_message( 'bio_init', 'end' )
    12321238
    12331239 END SUBROUTINE bio_init
  • palm/trunk/SOURCE/bulk_cloud_model_mod.f90

    r3874 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3874 2019-04-08 16:53:48Z knoop
    2731! Implemented non_transport_physics module interfaces
    2832!
     
    239243
    240244    USE control_parameters,                                                    &
    241         ONLY:  dt_3d, dt_do2d_xy, intermediate_timestep_count,                 &
     245        ONLY:  debug_output,                                                   &
     246               dt_3d, dt_do2d_xy, intermediate_timestep_count,                 &
    242247               intermediate_timestep_count_max, large_scale_forcing,           &
    243248               lsf_surf, pt_surface, rho_surface, surface_pressure,            &
     
    934939       INTEGER(iwp) ::  j !<
    935940
    936        CALL location_message( 'initializing bulk cloud module', .FALSE. )
     941       IF ( debug_output )  CALL debug_message( 'bcm_init', 'start' )
    937942
    938943       IF ( bulk_cloud_model )  THEN
     
    10151020          dpirho_l = 1.0_wp / pirho_l
    10161021
    1017           CALL location_message( 'finished', .TRUE. )
     1022          IF ( debug_output )  CALL debug_message( 'bcm_init', 'end' )
    10181023
    10191024       ELSE
    10201025
    1021           CALL location_message( 'skipped', .TRUE. )
     1026          IF ( debug_output )  CALL debug_message( 'bcm_init skipped', 'end' )
    10221027
    10231028       ENDIF
  • palm/trunk/SOURCE/check_parameters.f90

    r3766 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3766 2019-02-26 16:23:41Z raasch
    2731! trim added to avoid truncation compiler warnings
    2832!
     
    859863
    860864
    861     CALL location_message( 'checking parameters', .FALSE. )
     865    CALL location_message( 'checking parameters', 'start' )
    862866!
    863867!-- At first, check static and dynamic input for consistency
     
    38513855    ENDIF
    38523856
    3853     CALL location_message( 'finished', .TRUE. )
     3857    CALL location_message( 'checking parameters', 'finished' )
    38543858
    38553859 CONTAINS
  • palm/trunk/SOURCE/chem_emissions_mod.f90

    r3831 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2018-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2018-2018 Freie Universitaet Berlin
    19 ! Copyright 2018-2018 Karlsruhe Institute of Technology
     17! Copyright 2018-2019 Leibniz Universitaet Hannover
     18! Copyright 2018-2019 Freie Universitaet Berlin
     19! Copyright 2018-2019 Karlsruhe Institute of Technology
    2020!--------------------------------------------------------------------------------!
    2121!
     
    2727! -----------------
    2828! $Id$
     29! Changes related to global restructuring of location messages and introduction
     30! of additional debug messages
     31!
     32! 3831 2019-03-28 09:11:22Z forkel
    2933! added nvar to USE chem_gasphase_mod (chem_modules will not include nvar anymore)
    3034!
     
    112116
    113117    USE control_parameters,                                                    &
    114         ONLY:  end_time, message_string, initializing_actions,                 &
     118        ONLY:  debug_output,                                                   &
     119               end_time, message_string, initializing_actions,                 &
    115120               intermediate_timestep_count, dt_3d
    116121 
     
    248253
    249254
    250     CALL location_message( 'Matching input emissions and model chemistry species', .FALSE. )
     255    IF ( debug_output )  CALL debug_message( 'chem_emissions_match', 'start' )
    251256
    252257    !
     
    696701       END SELECT
    697702
     703       IF ( debug_output )  CALL debug_message( 'chem_emissions_match', 'end' )
     704
    698705 END SUBROUTINE chem_emissions_match
    699706
     
    728735
    729736
    730   CALL location_message( 'Starting initialization of emission arrays', .FALSE. )
     737  IF ( debug_output )  CALL debug_message( 'chem_emissions_init', 'start' )
    731738
    732739  !
     
    802809
    803810  ENDIF   
     811
     812  IF ( debug_output )  CALL debug_message( 'chem_emissions_init', 'end' )
    804813
    805814 END SUBROUTINE chem_emissions_init
  • 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,*) ' '
  • palm/trunk/SOURCE/cpulog_mod.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! output format limited to a maximum line length of 80
    2832!
     
    337341
    338342
    339        CALL location_message( 'calculating cpu statistics', .FALSE. )
     343       CALL location_message( 'calculating cpu statistics', 'start' )
    340344
    341345!
     
    580584       ENDIF
    581585
    582        CALL location_message( 'finished', .TRUE. )
     586       CALL location_message( 'calculating cpu statistics', 'finished' )
     587
    583588
    584589   100 FORMAT (A/11('-')//'CPU measures for ',I5,' PEs (',I5,'(x) * ',I5,'(y', &
  • palm/trunk/SOURCE/data_output_2d.f90

    r3766 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3766 2019-02-26 16:23:41Z raasch
    2731! unused variables removed
    2832!
     
    298302    USE control_parameters,                                                    &
    299303        ONLY:  data_output_2d_on_each_pe,                                      &
    300                data_output_xy, data_output_xz, data_output_yz, do2d,           &
     304               data_output_xy, data_output_xz, data_output_yz,                 &
     305               debug_output, debug_string,                                     &
     306               do2d,                                                           &
    301307               do2d_xy_last_time, do2d_xy_time_count,                          &
    302308               do2d_xz_last_time, do2d_xz_time_count,                          &
     
    394400    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which shall be output
    395401
     402
     403    IF ( debug_output )  THEN
     404       WRITE( debug_string, * ) 'data_output_2d'
     405       CALL debug_message( debug_string, 'start' )
     406    ENDIF
    396407!
    397408!-- Immediate return, if no output is requested (no respective sections
     
    22642275    CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
    22652276
     2277    IF ( debug_output )  THEN
     2278       WRITE( debug_string, * ) 'data_output_2d'
     2279       CALL debug_message( debug_string, 'end' )
     2280    ENDIF
     2281
    22662282 END SUBROUTINE data_output_2d
  • palm/trunk/SOURCE/data_output_3d.f90

    r3814 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3814 2019-03-26 08:40:31Z pavelkrc
    2731! unused variables removed
    2832!
     
    258262
    259263    USE control_parameters,                                                    &
    260         ONLY:  do3d, do3d_no, do3d_time_count, io_blocks, io_group,            &
     264        ONLY:  debug_output, debug_string,                                     &
     265               do3d, do3d_no, do3d_time_count, io_blocks, io_group,            &
    261266               land_surface, message_string, ntdim_3d, nz_do3d, psolver,       &
    262267               time_since_reference_point, urban_surface, varnamelength
     
    335340!-- Return, if nothing to output
    336341    IF ( do3d_no(av) == 0 )  RETURN
     342
     343    IF ( debug_output )  THEN
     344       WRITE( debug_string, * ) 'data_output_3d'
     345       CALL debug_message( debug_string, 'start' )
     346    ENDIF
    337347
    338348    CALL cpu_log (log_point(14),'data_output_3d','start')
     
    866876    CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
    867877
     878    IF ( debug_output )  THEN
     879       WRITE( debug_string, * ) 'data_output_3d'
     880       CALL debug_message( debug_string, 'end' )
     881    ENDIF
     882
    868883 END SUBROUTINE data_output_3d
  • palm/trunk/SOURCE/indoor_model_mod.f90

    r3786 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2018-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2018-2018 Hochschule Offenburg
     17! Copyright 2018-2019 Leibniz Universitaet Hannover
     18! Copyright 2018-2019 Hochschule Offenburg
    1919!--------------------------------------------------------------------------------!
    2020!
     
    2626! -----------------
    2727! $Id$
     28! Changes related to global restructuring of location messages and introduction
     29! of additional debug messages
     30!
     31! 3786 2019-03-06 16:58:03Z raasch
    2832! unused variables removed
    2933!
     
    8993
    9094    USE control_parameters,                                                    &
    91         ONLY:  initializing_actions
     95        ONLY:  debug_output, initializing_actions
    9296
    9397    USE kinds
     
    432436                                                           !< on local subdomain
    433437
    434     CALL location_message( 'initializing indoor model', .FALSE. )
     438    IF ( debug_output )  CALL debug_message( 'im_init', 'start' )
    435439
    436440!
     
    961965    ENDDO
    962966
    963     CALL location_message( 'finished', .TRUE. )
     967    IF ( debug_output )  CALL debug_message( 'im_init', 'end' )
    964968
    965969 END SUBROUTINE im_init
  • palm/trunk/SOURCE/init_3d_model.f90

    r3849 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3849 2019-04-01 16:35:16Z knoop
    2731! Move initialization of rmask before initializing user_init_arrays
    2832!
     
    723727    INTEGER(iwp) ::  nz_s_shift_l !< topography-top index on scalar-grid, used to vertically shift initial profiles
    724728
    725     CALL location_message( 'allocating arrays', .FALSE. )
     729    CALL location_message( 'init_3d_model', 'start' )
     730    CALL location_message( 'allocating arrays', 'start' )
    726731!
    727732!-- Allocate arrays
     
    10721077    intermediate_timestep_count = 0  ! needed when simulated_time = 0.0
    10731078       
    1074     CALL location_message( 'finished', .TRUE. )
     1079    CALL location_message( 'allocating arrays', 'finished' )
    10751080
    10761081!
     
    10951100!--    Initialization with provided input data derived from larger-scale model
    10961101       IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
    1097           CALL location_message( 'initializing with INIFOR', .FALSE. )
     1102          CALL location_message( 'initializing with INIFOR', 'start' )
    10981103!
    10991104!--       Read initial 1D profiles or 3D data from NetCDF file, depending
     
    12471252          IF( use_syn_turb_gen )  CALL stg_init
    12481253
    1249           CALL location_message( 'finished', .TRUE. )
     1254          CALL location_message( 'initializing with INIFOR', 'finished' )
    12501255!
    12511256!--    Initialization via computed 1D-model profiles
    12521257       ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
    12531258
    1254           CALL location_message( 'initializing with 1D model profiles', .FALSE. )
     1259          CALL location_message( 'initializing with 1D model profiles', 'start' )
    12551260!
    12561261!--       Use solutions of the 1D model as initial profiles,
     
    13171322          IF( use_syn_turb_gen )  CALL stg_init
    13181323
    1319           CALL location_message( 'finished', .TRUE. )
     1324          CALL location_message( 'initializing with 1D model profiles', 'finished' )
    13201325
    13211326       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )    &
    13221327       THEN
    13231328
    1324           CALL location_message( 'initializing with constant profiles', .FALSE. )
     1329          CALL location_message( 'initializing with constant profiles', 'start' )
    13251330
    13261331!
     
    13881393          IF( use_syn_turb_gen )  CALL stg_init
    13891394         
    1390           CALL location_message( 'finished', .TRUE. )
     1395          CALL location_message( 'initializing with constant profiles', 'finished' )
    13911396
    13921397       ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 )                  &
    13931398       THEN
    13941399
    1395           CALL location_message( 'initializing by user', .FALSE. )
     1400          CALL location_message( 'initializing by user', 'start' )
    13961401!
    13971402!--       Pre-initialize surface variables, i.e. setting start- and end-indices
     
    14031408          CALL user_init_3d_model
    14041409
    1405           CALL location_message( 'finished', .TRUE. )
    1406 
    1407        ENDIF
    1408 
    1409        CALL location_message( 'initializing statistics, boundary conditions, etc.', &
    1410                               .FALSE. )
     1410          CALL location_message( 'initializing by user', 'finished' )
     1411
     1412       ENDIF
     1413
     1414       CALL location_message( 'initializing statistics, boundary conditions, etc.', 'start' )
    14111415
    14121416!
     
    15421546       ENDIF       
    15431547
    1544        CALL location_message( 'finished', .TRUE. )
     1548       CALL location_message( 'initializing statistics, boundary conditions, etc.', 'finished' )
    15451549
    15461550    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.         &
     
    15481552    THEN
    15491553
    1550        CALL location_message( 'initializing in case of restart / cyclic_fill', &
    1551                               .FALSE. )
     1554       CALL location_message( 'initializing in case of restart / cyclic_fill', 'start' )
    15521555!
    15531556!--    Initialize surface elements and its attributes, e.g. heat- and
     
    18131816            use_syn_turb_gen )  CALL stg_init
    18141817
    1815        CALL location_message( 'finished', .TRUE. )
     1818       CALL location_message( 'initializing in case of restart / cyclic_fill', 'finished' )
    18161819
    18171820    ELSE
     
    21812184!$ACC COPY(v(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
    21822185
    2183        CALL location_message( 'creating initial disturbances', .FALSE. )
     2186       CALL location_message( 'creating initial disturbances', 'start' )
    21842187       CALL disturb_field( 'u', tend, u )
    21852188       CALL disturb_field( 'v', tend, v )
    2186        CALL location_message( 'finished', .TRUE. )
     2189       CALL location_message( 'creating initial disturbances', 'finished' )
    21872190
    21882191!$ACC DATA &
     
    22012204!$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns))
    22022205
    2203        CALL location_message( 'calling pressure solver', .FALSE. )
     2206       CALL location_message( 'applying pressure solver', 'start' )
    22042207       n_sor = nsor_ini
    22052208       CALL pres
    22062209       n_sor = nsor
    2207        CALL location_message( 'finished', .TRUE. )
     2210       CALL location_message( 'applying pressure solver', 'finished' )
    22082211
    22092212!$ACC END DATA
     
    24182421
    24192422
    2420     CALL location_message( 'leaving init_3d_model', .TRUE. )
     2423    CALL location_message( 'init_3d_model', 'finished' )
    24212424
    24222425 END SUBROUTINE init_3d_model
  • palm/trunk/SOURCE/init_pegrid.f90

    r3884 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3884 2019-04-10 13:31:55Z Giersch
    2731! id_recycling is only calculated in case of tubulent inflow
    2832!
     
    348352#if defined( __parallel )
    349353
    350     CALL location_message( 'creating virtual PE grids + MPI derived data types', &
    351                            .FALSE. )
     354    CALL location_message( 'creating virtual PE grids + MPI derived data types', 'start' )
    352355
    353356!
     
    13941397    ENDIF
    13951398
    1396     CALL location_message( 'finished', .TRUE. )
     1399    CALL location_message( 'creating virtual PE grids + MPI derived data types', 'finished' )
    13971400
    13981401#else
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r3881 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3881 2019-04-10 09:31:22Z suehring
    2731! Bugfix in level 3 initialization of pavement albedo type and pavement
    2832! emissivity
     
    544548
    545549    USE control_parameters,                                                    &
    546         ONLY:  cloud_droplets, coupling_start_time, dt_3d,      &
     550        ONLY:  cloud_droplets, coupling_start_time,                            &
     551               debug_output, debug_string,                                     &
     552               dt_3d,                                                          &
    547553               end_time, humidity, intermediate_timestep_count,                &
    548554               initializing_actions, intermediate_timestep_count_max,          &
     
    18901896    TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
    18911897
     1898!
     1899!-- Debug location message
     1900    IF ( debug_output )  THEN
     1901       WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l
     1902       CALL debug_message( debug_string, 'start' )
     1903    ENDIF
     1904
    18921905    IF ( horizontal )  THEN
    18931906       surf              => surf_lsm_h
     
    24492462    IF ( horizontal  .AND.  .NOT. constant_roughness )  CALL calc_z0_water_surface
    24502463   
    2451    
     2464    IF ( debug_output )  THEN
     2465       WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l
     2466       CALL debug_message( debug_string, 'end' )
     2467    ENDIF
     2468
    24522469    CONTAINS
    24532470!------------------------------------------------------------------------------!
     
    26322649       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_soil_init !< temporary array used for averaging soil profiles
    26332650
    2634        CALL location_message( 'initializing land surface model', .FALSE. )
     2651       IF ( debug_output )  CALL debug_message( 'lsm_init', 'start' )
    26352652!
    26362653!--    If no cloud physics is used, rho_surface has not been calculated before
     
    49424959       ENDDO
    49434960
    4944        CALL location_message( 'finished', .TRUE. )
     4961       IF ( debug_output )  CALL debug_message( 'lsm_init', 'end' )
    49454962
    49464963    END SUBROUTINE lsm_init
     
    52715288       TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
    52725289
     5290
     5291       IF ( debug_output )  THEN
     5292          WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
     5293          CALL debug_message( debug_string, 'start' )
     5294       ENDIF
     5295
    52735296       IF ( horizontal )  THEN
    52745297          surf           => surf_lsm_h
     
    55665589       ENDDO
    55675590       !$OMP END PARALLEL
     5591!
     5592!--    Debug location message
     5593       IF ( debug_output )  THEN
     5594          WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
     5595          CALL debug_message( debug_string, 'end' )
     5596       ENDIF
    55685597
    55695598    END SUBROUTINE lsm_soil_model
  • 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
  • palm/trunk/SOURCE/module_interface.f90

    r3880 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3880 2019-04-08 21:43:02Z knoop
    2731! Add a call for salsa_prognostic_equations
    2832!
     
    790794
    791795
     796    CALL location_message( 'initializing module-specific arrays', 'start' )
     797
    792798    IF ( bulk_cloud_model    )  CALL bcm_init_arrays
    793799    IF ( air_chemistry       )  CALL chem_init_arrays
     
    801807    IF ( user_module_enabled )  CALL user_init_arrays
    802808
     809    CALL location_message( 'initializing module-specific arrays', 'finished' )
     810
    803811
    804812 END SUBROUTINE module_interface_init_arrays
     
    812820 SUBROUTINE module_interface_init
    813821
     822
     823    CALL location_message( 'initializing module features', 'start' )
    814824
    815825    IF ( biometeorology      )  CALL bio_init
     
    831841    IF ( user_module_enabled )  CALL user_init
    832842
     843    CALL location_message( 'initializing module features', 'finished' )
     844
    833845
    834846 END SUBROUTINE module_interface_init
  • palm/trunk/SOURCE/modules.f90

    r3871 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3871 2019-04-08 14:38:39Z knoop
    2731! Initialized parameter region
    2832!
     
    11461150    CHARACTER (LEN=100)  ::  restart_string = ' '                         !< for storing strings in case of writing/reading restart data
    11471151    CHARACTER (LEN=210)  ::  run_description_header                       !< string containing diverse run informations as run identifier, coupling mode, host, ensemble number, run date and time
     1152    CHARACTER (LEN=1000) ::  debug_string = ' '                           !<.....
    11481153    CHARACTER (LEN=1000) ::  message_string = ' '                         !< dynamic string for error message output
    11491154
     
    13181323    LOGICAL ::  data_output_during_spinup = .FALSE.              !< namelist parameter
    13191324    LOGICAL ::  data_output_2d_on_each_pe = .TRUE.               !< namelist parameter
     1325    LOGICAL ::  debug_output = .FALSE.                           !< namelist parameter
    13201326    LOGICAL ::  disturbance_created = .FALSE.                    !< flow disturbance imposed?
    13211327    LOGICAL ::  do2d_at_begin = .FALSE.                          !< namelist parameter
  • palm/trunk/SOURCE/multi_agent_system_mod.f90

    r3876 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2016 Leibniz Universitaet Hannover
     17! Copyright 2016-2019 Leibniz Universitaet Hannover
    1818!------------------------------------------------------------------------------!
    1919!
     
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3876 2019-04-08 18:41:49Z knoop
    2731! replaced nspec by nvar: only variable species should bconsidered, fixed species are not relevant
    2832!
     
    109113
    110114    USE control_parameters,                                                    &
    111         ONLY:  biometeorology, dt_3d, dt_write_agent_data, message_string,     &
     115        ONLY:  biometeorology,                                                 &
     116               debug_output,                                                   &
     117               debug_string,                                                   &
     118               dt_3d,                                                          &
     119               dt_write_agent_data,                                            &
     120               message_string,                                                 &
    112121               time_since_reference_point
    113122
     
    387396    LOGICAL       ::  first_loop_stride   !< flag for first loop stride of agent sub-timesteps
    388397    LOGICAL, SAVE ::  first_call = .TRUE. !< first call of mas flag for output
     398!
     399!-- Debug location message
     400    IF ( debug_output )  THEN
     401       WRITE( debug_string, * ) 'multi_agent_system'
     402       CALL debug_message( debug_string, 'start' )
     403    ENDIF
    389404
    390405    CALL cpu_log( log_point(9), 'mas', 'start' )
     
    607622
    608623    CALL cpu_log( log_point(9), 'mas', 'stop' )
     624!
     625!-- Debug location message
     626    IF ( debug_output )  THEN
     627       WRITE( debug_string, * ) 'multi_agent_system'
     628       CALL debug_message( debug_string, 'end' )
     629    ENDIF
    609630
    610631 END SUBROUTINE multi_agent_system
  • palm/trunk/SOURCE/nesting_offl_mod.f90

    r3876 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30!
    2731! Do local data exchange for chemistry variables only when boundary data is 
    2832! coming from dynamic file
     
    6872    USE control_parameters,                                                    &
    6973        ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r,  &
    70                bc_dirichlet_s, dt_3d, dz, constant_diffusion, humidity,        &
     74               bc_dirichlet_s, dt_3d, dz, constant_diffusion,                  &
     75               debug_output, debug_string,                                     &
     76               humidity,                                                       &
    7177               message_string, nesting_offline, neutral, passive_scalar,       &
    7278               rans_mode, rans_tke_e, time_since_reference_point, volume_flow
     
    150156       REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !< local volume flow
    151157
     158!
     159!--    Debug location message
     160       IF ( debug_output )  THEN
     161          WRITE( debug_string, * ) 'nesting_offl_mass_conservation'
     162          CALL debug_message( debug_string, 'start' )
     163       ENDIF
    152164       
    153165       CALL  cpu_log( log_point(58), 'offline nesting', 'start' )
     
    226238       
    227239       CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
     240!
     241!--    Debug location message
     242       IF ( debug_output )  THEN
     243          WRITE( debug_string, * ) 'nesting_offl_mass_conservation'
     244          CALL debug_message( debug_string, 'end' )
     245       ENDIF
    228246
    229247    END SUBROUTINE nesting_offl_mass_conservation
     
    258276       REAL(wp), DIMENSION(nzb:nzt+1) ::  v_ref_l  !< reference profile for v-component on subdomain
    259277       
     278!
     279!--    Debug location message
     280       IF ( debug_output )  THEN
     281          WRITE( debug_string, * ) 'nesting_offl_bc'
     282          CALL debug_message( debug_string, 'start' )
     283       ENDIF
     284
    260285       CALL  cpu_log( log_point(58), 'offline nesting', 'start' )     
    261286!
     
    782807   
    783808       CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
     809!
     810!--    Debug location message
     811       IF ( debug_output )  THEN
     812          WRITE( debug_string, * ) 'nesting_offl_bc'
     813          CALL debug_message( debug_string, 'end' )
     814       ENDIF
    784815
    785816    END SUBROUTINE nesting_offl_bc
  • palm/trunk/SOURCE/netcdf_data_input_mod.f90

    r3864 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3864 2019-04-05 09:01:56Z monakurppa
    2731! get_variable_4d_to_3d_real modified to enable read in data of type
    2832! data(t,y,x,n) one timestep at a time + some routines made public
     
    13911395!--
    13921396       !> Start the processing of the data
    1393        CALL location_message( 'starting allocation of chemistry emissions arrays', .FALSE. )
    13941397
    13951398       !> Parameterized mode of the emissions
  • palm/trunk/SOURCE/palm.f90

    r3761 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3761 2019-02-25 15:31:42Z raasch
    2731! unused variable removed
    2832!
     
    573577       CALL cpu_log( log_point(22), 'wrd_local', 'start' )
    574578
    575        CALL location_message( 'writing restart data', .FALSE. )
     579       CALL location_message( 'writing restart data', 'start' )
    576580
    577581       DO  i = 0, io_blocks-1
     
    597601       ENDDO
    598602
    599        CALL location_message( 'finished', .TRUE. )
     603       CALL location_message( 'writing restart data', 'finished' )
    600604
    601605       CALL cpu_log( log_point(22), 'wrd_local', 'stop' )
  • palm/trunk/SOURCE/parin.f90

    r3806 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3806 2019-03-21 12:45:50Z raasch
    2731! additional check for lateral boundary conditions added
    2832!
     
    690694             cpu_log_barrierwait, create_disturbances,                         &
    691695             cross_profiles, data_output, data_output_masks,                   &
    692              data_output_pr, data_output_2d_on_each_pe, disturbance_amplitude, &
     696             data_output_pr, data_output_2d_on_each_pe,                        &
     697             debug_output,                                                     &
     698             disturbance_amplitude,                                            &
    693699             disturbance_energy_limit, disturbance_level_b,                    &
    694700             disturbance_level_t, do2d_at_begin, do3d_at_begin,                &
     
    712718             cpu_log_barrierwait, create_disturbances,                         &
    713719             cross_profiles, data_output, data_output_masks,                   &
    714              data_output_pr, data_output_2d_on_each_pe, disturbance_amplitude, &
     720             data_output_pr, data_output_2d_on_each_pe,                        &
     721             debug_output,                                                     &
     722             disturbance_amplitude,                                            &
    715723             disturbance_energy_limit, disturbance_level_b,                    &
    716724             disturbance_level_t, do2d_at_begin, do3d_at_begin,                &
     
    739747!-- First read values of environment variables (this NAMELIST file is
    740748!-- generated by palmrun)
    741     CALL location_message( 'reading environment parameters from ENVPAR', .FALSE. )
     749    CALL location_message( 'reading environment parameters from ENVPAR', 'start' )
    742750
    743751    OPEN ( 90, FILE='ENVPAR', STATUS='OLD', FORM='FORMATTED', IOSTAT=ioerr )
     
    762770    ENDIF
    763771
    764     CALL location_message( 'finished', .TRUE. )
     772    CALL location_message( 'reading environment parameters from ENVPAR', 'finished' )
    765773!
    766774!-- Calculate the number of groups into which parallel I/O is split.
     
    794802    io_group  = MOD( global_id+1, io_blocks )
    795803   
    796     CALL location_message( 'reading NAMELIST parameters from PARIN', .FALSE. )
     804    CALL location_message( 'reading NAMELIST parameters from PARIN', 'start' )
    797805!
    798806!-- Data is read in parallel by groups of PEs
     
    10981106    ENDDO
    10991107
    1100     CALL location_message( 'finished', .TRUE. )
     1108    CALL location_message( 'reading NAMELIST parameters from PARIN', 'finished' )
    11011109
    11021110 END SUBROUTINE parin
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r3864 r3885  
    1616!
    1717! Copyright 1997-2019 Leibniz Universitaet Hannover
    18 ! Copyright 2018 Institute of Computer Science of the
    19 !                Czech Academy of Sciences, Prague
     18! Copyright 2017-2019 Institute of Computer Science of the
     19!                     Czech Academy of Sciences, Prague
    2020!------------------------------------------------------------------------------!
    2121!
    2222! Current revisions:
    2323! ------------------
    24 !
     24! 
    2525!
    2626! Former revisions:
    2727! -----------------
    2828! $Id$
     29! Changes related to global restructuring of location messages and introduction
     30! of additional debug messages
     31!
     32! 3864 2019-04-05 09:01:56Z monakurppa
    2933! unsed variables removed
    3034!
     
    254258        ONLY:  c_p, degc_to_k, l_v, lv_d_cp, r_d, rd_d_rv
    255259
    256     USE control_parameters,                                                   &
    257         ONLY: humidity
     260    USE control_parameters,                                                    &
     261        ONLY: debug_output, humidity
    258262
    259263    USE indices,                                                               &
     
    913917       REAL(wp) ::  canopy_height   !< canopy height for lad-profile construction
    914918
    915        CALL location_message( 'initializing plant canopy model', .FALSE. )
     919       IF ( debug_output )  CALL debug_message( 'pcm_init', 'start' )
    916920!
    917921!--    Allocate one-dimensional arrays for the computation of the
     
    12211225       ENDIF
    12221226
    1223        CALL location_message( 'finished', .TRUE. )
     1227       IF ( debug_output )  CALL debug_message( 'pcm_init', 'end' )
    12241228
    12251229
  • palm/trunk/SOURCE/pmc_handle_communicator_mod.f90

    r3819 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3819 2019-03-27 11:01:36Z hellstea
    2731! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled
    2832! by the new nesting_parameters parameter anterpolation_buffer_width.
     
    524528!
    525529!-- Output location message
    526     CALL location_message( 'initialize communicators for nesting', .FALSE. )
     530    CALL location_message( 'initialize communicators for nesting', 'start' )
    527531!
    528532!-- Assign the layout to the corresponding internally used variable m_couplers
     
    563567    ENDIF
    564568
     569    CALL location_message( 'initialize communicators for nesting', 'finished' )
     570
    565571 END SUBROUTINE read_coupling_layout
    566572
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3883 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3883 2019-04-10 12:51:50Z hellstea
    2731! Checks and error messages improved and extended. All the child index bounds in the
    2832! parent-grid index space are made module variables. Function get_number_of_childs
     
    405409               bc_dirichlet_s, child_domain,                                   &
    406410               constant_diffusion, constant_flux_layer,                        &
    407                coupling_char, dt_3d, dz, humidity, message_string,             &
     411               coupling_char,                                                  &
     412               debug_output, debug_string,                                     &
     413               dt_3d, dz, humidity, message_string,                            &
    408414               neutral, passive_scalar, rans_mode, rans_tke_e,                 &
    409415               roughness_length, salsa, topography, volume_flow
     
    790796!-- Attention: myid has been set at the end of pmc_init_model in order to
    791797!-- guarantee that only PE0 of the root domain does the output.
    792     CALL location_message( 'finished', .TRUE. )
     798    CALL location_message( 'initialize model nesting', 'finished' )
    793799!
    794800!-- Reset myid to its default value
     
    800806!-- world_comm is given a dummy value to avoid compiler warnings (INTENT(OUT)
    801807!-- should get an explicit value)
     808!-- todo: why don't we print an error message instead of these settings?
    802809    cpl_id     = 1
    803810    nested_run = .FALSE.
     
    817824   
    818825#if defined( __parallel )
    819     CALL location_message( 'setup the nested model configuration', .FALSE. )
     826    CALL location_message( 'setup the nested model configuration', 'start' )
    820827    CALL cpu_log( log_point_s(79), 'pmci_model_config', 'start' )
    821828!
     
    844851
    845852    CALL cpu_log( log_point_s(79), 'pmci_model_config', 'stop' )
    846     CALL location_message( 'finished', .TRUE. )
     853    CALL location_message( 'setup the nested model configuration', 'finished' )
    847854#endif
    848855
     
    30503057   REAL(wp) ::  dtg       !<  Global time step defined as the global minimum of dtl of all processes
    30513058
     3059    IF ( debug_output )  THEN
     3060       WRITE( debug_string, * ) 'pmci_synchronize'
     3061       CALL debug_message( debug_string, 'start' )
     3062    ENDIF
    30523063   
    30533064   dtl = dt_3d
    30543065   CALL MPI_ALLREDUCE( dtl, dtg, 1, MPI_REAL, MPI_MIN, MPI_COMM_WORLD, ierr )
    30553066   dt_3d  = dtg
     3067
     3068    IF ( debug_output )  THEN
     3069       WRITE( debug_string, * ) 'pmci_synchronize'
     3070       CALL debug_message( debug_string, 'end' )
     3071    ENDIF
    30563072
    30573073#endif
     
    30993115    CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode  !<  Nesting mode: 'one-way', 'two-way' or 'vertical'
    31003116
     3117!
     3118!-- Debug location message
     3119    IF ( debug_output )  THEN
     3120       WRITE( debug_string, * ) 'pmci_datatrans'
     3121       CALL debug_message( debug_string, 'start' )
     3122    ENDIF
    31013123
    31023124    IF ( TRIM( local_nesting_mode ) == 'one-way' )  THEN
     
    31333155       ENDIF
    31343156
     3157    ENDIF
     3158!
     3159!-- Debug location message
     3160    IF ( debug_output )  THEN
     3161       WRITE( debug_string, * ) 'pmci_datatrans'
     3162       CALL debug_message( debug_string, 'end' )
    31353163    ENDIF
    31363164
     
    46004628    INTEGER(iwp) ::  n   !< Running index for number of chemical species
    46014629   
     4630!
     4631!-- Debug location message
     4632    IF ( debug_output )  THEN
     4633       WRITE( debug_string, * ) 'pmci_boundary_conds'
     4634       CALL debug_message( debug_string, 'start' )
     4635    ENDIF
    46024636!
    46034637!-- Set Dirichlet boundary conditions for horizontal velocity components
     
    47864820       ENDIF
    47874821    ENDIF   
     4822!
     4823!-- Debug location message
     4824    IF ( debug_output )  THEN
     4825       WRITE( debug_string, * ) 'pmci_boundary_conds'
     4826       CALL debug_message( debug_string, 'end' )
     4827    ENDIF
    47884828
    47894829 END SUBROUTINE pmci_boundary_conds
  • palm/trunk/SOURCE/prognostic_equations.f90

    r3881 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3881 2019-04-10 09:31:22Z suehring
    2731! Bugfix in OpenMP directive
    2832!
     
    395399    USE control_parameters,                                                    &
    396400        ONLY:  air_chemistry, constant_diffusion,                              &
     401               debug_output, debug_string,                                     &
    397402               dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d,    &
    398403               humidity, intermediate_timestep_count,                          &
     
    517522
    518523
     524
     525    IF ( debug_output )  THEN
     526       WRITE( debug_string, * ) 'prognostic_equations_cache'
     527       CALL debug_message( debug_string, 'start' )
     528    ENDIF
    519529!
    520530!-- Time measurement can only be performed for the whole set of equations
     
    11151125    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
    11161126
     1127    IF ( debug_output )  THEN
     1128       WRITE( debug_string, * ) 'prognostic_equations_cache'
     1129       CALL debug_message( debug_string, 'end' )
     1130    ENDIF
    11171131
    11181132 END SUBROUTINE prognostic_equations_cache
     
    11381152    REAL(wp)     ::  sbt  !<
    11391153
     1154
     1155    IF ( debug_output )  THEN
     1156       WRITE( debug_string, * ) 'prognostic_equations_vector'
     1157       CALL debug_message( debug_string, 'start' )
     1158    ENDIF
    11401159!
    11411160!-- Run SALSA and aerosol dynamic processes. SALSA is run with a longer time
     
    18691888    CALL module_interface_prognostic_equations()
    18701889
     1890    IF ( debug_output )  THEN
     1891       WRITE( debug_string, * ) 'prognostic_equations_vector'
     1892       CALL debug_message( debug_string, 'end' )
     1893    ENDIF
     1894
    18711895 END SUBROUTINE prognostic_equations_vector
    18721896
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r3881 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2015-2018 Institute of Computer Science of the
     17! Copyright 2015-2019 Institute of Computer Science of the
    1818!                     Czech Academy of Sciences, Prague
    19 ! Copyright 2015-2018 Czech Technical University in Prague
     19! Copyright 2015-2019 Czech Technical University in Prague
    2020! Copyright 1997-2019 Leibniz Universitaet Hannover
    2121!------------------------------------------------------------------------------!
     
    2828! -----------------
    2929! $Id$
     30! Changes related to global restructuring of location messages and introduction
     31! of additional debug messages
     32!
     33! 3881 2019-04-10 09:31:22Z suehring
    3034! Output of albedo and emissivity moved from USM, bugfixes in initialization
    3135! of albedo
     
    612616
    613617    USE control_parameters,                                                    &
    614         ONLY:  cloud_droplets, coupling_char, dz, dt_spinup, end_time,         &
     618        ONLY:  cloud_droplets, coupling_char,                                  &
     619               debug_output, debug_string,                                     &
     620               dz, dt_spinup, end_time,                                        &
    615621               humidity,                                                       &
    616622               initializing_actions, io_blocks, io_group,                      &
     
    13471353
    13481354
     1355       IF ( debug_output )  CALL debug_message( 'radiation_control', 'start' )
     1356
     1357
    13491358       SELECT CASE ( TRIM( radiation_scheme ) )
    13501359
     
    13621371       END SELECT
    13631372
     1373       IF ( debug_output )  CALL debug_message( 'radiation_control', 'end' )
    13641374
    13651375    END SUBROUTINE radiation_control
     
    18351845#endif
    18361846
     1847
     1848       IF ( debug_output )  CALL debug_message( 'radiation_init', 'start' )
    18371849!
    18381850!--    Activate radiation_interactions according to the existence of vertical surfaces and/or trees.
     
    18581870!--    via sky-view factors. This must be done before radiation is initialized.
    18591871       IF ( radiation_interactions )  CALL radiation_interaction_init
    1860 
    1861 !
    1862 !--    Initialize radiation model
    1863        CALL location_message( 'initializing radiation model', .FALSE. )
    1864 
    18651872!
    18661873!--    Allocate array for storing the surface net radiation
     
    28562863       CALL init_date_and_time
    28572864
    2858        CALL location_message( 'finished', .TRUE. )
    2859 
    28602865!
    28612866!--    Find all discretized apparent solar positions for radiation interaction.
     
    28672872!
    28682873!--       Read sky-view factors and further required data from file
    2869           CALL location_message( '    Start reading SVF from file', .FALSE. )
    28702874          CALL radiation_read_svf()
    2871           CALL location_message( '    Reading SVF from file has finished', .TRUE. )
    28722875
    28732876       ELSEIF ( radiation_interactions .AND. .NOT. read_svf)  THEN
    28742877!
    28752878!--       calculate SFV and CSF
    2876           CALL location_message( '    Start calculation of SVF', .FALSE. )
    28772879          CALL radiation_calc_svf()
    2878           CALL location_message( '    Calculation of SVF has finished', .TRUE. )
    28792880       ENDIF
    28802881
     
    28822883!
    28832884!--       Write svf, csf svfsurf and csfsurf data to file
    2884           CALL location_message( '    Start writing SVF in file', .FALSE. )
    28852885          CALL radiation_write_svf()
    2886           CALL location_message( '    Writing SVF in file has finished', .TRUE. )
    28872886       ENDIF
    28882887
     
    28942893       ENDIF
    28952894
    2896        RETURN
     2895       IF ( debug_output )  CALL debug_message( 'radiation_init', 'end' )
     2896
     2897       RETURN !todo: remove, I don't see what we need this for here
    28972898
    28982899    END SUBROUTINE radiation_init
     
    51045105
    51055106
     5107     IF ( debug_output )  CALL debug_message( 'radiation_interaction', 'start' )
     5108
    51065109     IF ( plant_canopy )  THEN
    51075110         pchf_prep(:) = r_d * exner(nz_urban_b:nz_urban_t)                                 &
     
    58485851           (emissivity_urb*sigma_sb * area_hor) )**0.25_wp
    58495852
     5853     IF ( debug_output )  CALL debug_message( 'radiation_interaction', 'end' )
     5854
     5855
    58505856    CONTAINS
    58515857
     
    59785984    END SUBROUTINE calc_diffusion_radiation
    59795985
    5980 
    59815986 END SUBROUTINE radiation_interaction
    59825987   
     
    61436148!--    allocate urban surfaces grid
    61446149!--    calc number of surfaces in local proc
    6145        CALL location_message( '    calculation of indices for surfaces', .TRUE. )
     6150       IF ( debug_output )  CALL debug_message( 'calculation of indices for surfaces', 'info' )
     6151
    61466152       nsurfl = 0
    61476153!
     
    64786484!--
    64796485!--    allocation of the arrays for direct and diffusion radiation
    6480        CALL location_message( '    allocation of radiation arrays', .TRUE. )
     6486       IF ( debug_output )  CALL debug_message( 'allocation of radiation arrays', 'info' )
    64816487!--    rad_sw_in, rad_lw_in are computed in radiation model,
    64826488!--    splitting of direct and diffusion part is done
     
    65776583!   
    65786584        INTEGER(iwp), DIMENSION(0:svfnorm_report_num) :: svfnorm_counts
    6579         CHARACTER(200)                                :: msg
     6585
    65806586
    65816587!--     calculation of the SVF
    6582         CALL location_message( '    calculation of SVF and CSF', .TRUE. )
    6583         CALL radiation_write_debug_log('Start calculation of SVF and CSF')
     6588        CALL location_message( 'calculating view factors for radiation interaction', 'start' )
    65846589
    65856590!--     initialize variables and temporary arrays for calculation of svf and csf
     
    69216926                     ENDIF
    69226927
    6923                      WRITE (msg,'(A,3I12)') 'Grow asvf:',nsvfl,nsvfla,k
    6924                      CALL radiation_write_debug_log( msg )
     6928                     IF ( debug_output )  THEN
     6929                        WRITE( debug_string, '(A,3I12)' ) 'Grow asvf:', nsvfl, nsvfla, k
     6930                        CALL debug_message( debug_string, 'info' )
     6931                     ENDIF
    69256932                     
    69266933                     nsvfla = k
     
    70047011                     ENDIF
    70057012
    7006                      WRITE(msg,'(A,3I12)') 'Grow asvf:',nsvfl,nsvfla,k
    7007                      CALL radiation_write_debug_log( msg )
     7013                     IF ( debug_output )  THEN
     7014                        WRITE( debug_string, '(A,3I12)' ) 'Grow asvf:', nsvfl, nsvfla, k
     7015                        CALL debug_message( debug_string, 'info' )
     7016                     ENDIF
    70087017                     
    70097018                     nsvfla = k
     
    71727181                    ENDIF
    71737182
    7174                     WRITE (msg,'(A,3I12)') 'Grow amrtf:', nmrtf, nmrtfa, k
    7175                     CALL radiation_write_debug_log( msg )
     7183                    IF ( debug_output )  THEN
     7184                       WRITE( debug_string, '(A,3I12)' ) 'Grow amrtf:', nmrtf, nmrtfa, k
     7185                       CALL debug_message( debug_string, 'info' )
     7186                    ENDIF
    71767187
    71777188                    nmrtfa = k
     
    72247235        ENDIF
    72257236
    7226         CALL radiation_write_debug_log( 'End of calculation SVF' )
    7227         WRITE(msg, *) 'Raytracing skipped for maximum distance of ', &
    7228            max_raytracing_dist, ' m on ', ray_skip_maxdist, ' pairs.'
    7229         CALL radiation_write_debug_log( msg )
    7230         WRITE(msg, *) 'Raytracing skipped for minimum potential value of ', &
    7231            min_irrf_value , ' on ', ray_skip_minval, ' pairs.'
    7232         CALL radiation_write_debug_log( msg )
    7233 
    7234         CALL location_message( '    waiting for completion of SVF and CSF calculation in all processes', .TRUE. )
     7237        IF ( debug_output )  CALL debug_message( 'waiting for completion of SVF and CSF calculation in all processes', 'info' )
     7238
    72357239!--     deallocate temporary global arrays
    72367240        DEALLOCATE(nzterr)
     
    72747278        ENDIF
    72757279
    7276         CALL location_message( '    calculation of the complete SVF array', .TRUE. )
     7280        IF ( debug_output )  CALL debug_message( 'calculation of the complete SVF array', 'info' )
    72777281
    72787282        IF ( rad_angular_discretization )  THEN
    7279            CALL radiation_write_debug_log( 'Load svf from the structure array to plain arrays' )
     7283           IF ( debug_output )  CALL debug_message( 'Load svf from the structure array to plain arrays', 'info' )
    72807284           ALLOCATE( svf(ndsvf,nsvfl) )
    72817285           ALLOCATE( svfsurf(idsvf,nsvfl) )
     
    72867290           ENDDO
    72877291        ELSE
    7288            CALL radiation_write_debug_log( 'Start SVF sort' )
     7292           IF ( debug_output )  CALL debug_message( 'Start SVF sort', 'info' )
    72897293!--        sort svf ( a version of quicksort )
    72907294           CALL quicksort_svf(asvf,1,nsvfl)
    72917295
    72927296           !< load svf from the structure array to plain arrays
    7293            CALL radiation_write_debug_log( 'Load svf from the structure array to plain arrays' )
     7297           IF ( debug_output )  CALL debug_message( 'Load svf from the structure array to plain arrays', 'info' )
    72947298           ALLOCATE( svf(ndsvf,nsvfl) )
    72957299           ALLOCATE( svfsurf(idsvf,nsvfl) )
     
    73467350        IF ( plant_canopy )  THEN
    73477351
    7348             CALL location_message( '    calculation of the complete CSF array', .TRUE. )
    7349             CALL radiation_write_debug_log( 'Calculation of the complete CSF array' )
     7352            IF ( debug_output )  CALL debug_message( 'Calculation of the complete CSF array', 'info' )
    73507353!--         sort and merge csf for the last time, keeping the array size to minimum
    73517354            CALL merge_and_grow_csf(-1)
     
    74197422!--         scatter and gather the number of elements to and from all processor
    74207423!--         and calculate displacements
    7421             CALL radiation_write_debug_log( 'Scatter and gather the number of elements to and from all processor' )
     7424            IF ( debug_output )  CALL debug_message( 'Scatter and gather the number of elements to and from all processor', 'info' )
     7425
    74227426            CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr)
     7427
    74237428            IF ( ierr /= 0 ) THEN
    74247429                WRITE(9,*) 'Error MPI_AlltoAll1:', ierr, SIZE(icsflt), SIZE(ipcsflt)
     
    74347439
    74357440!--         exchange csf fields between processors
    7436             CALL radiation_write_debug_log( 'Exchange csf fields between processors' )
     7441            IF ( debug_output )  CALL debug_message( 'Exchange csf fields between processors', 'info' )
    74377442            udim = max(npcsfl,1)
    74387443            ALLOCATE( pcsflt_l(ndcsf*udim) )
     
    74737478
    74747479!--         sort csf ( a version of quicksort )
    7475             CALL radiation_write_debug_log( 'Sort csf' )
     7480            IF ( debug_output )  CALL debug_message( 'Sort csf', 'info' )
    74767481            CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl)
    74777482
    74787483!--         aggregate canopy sink factor records with identical box & source
    74797484!--         againg across all values from all processors
    7480             CALL radiation_write_debug_log( 'Aggregate canopy sink factor records with identical box' )
     7485            IF ( debug_output )  CALL debug_message( 'Aggregate canopy sink factor records with identical box', 'info' )
    74817486
    74827487            IF ( npcsfl > 0 )  THEN
     
    75217526            DEALLOCATE( pcsflt_l )
    75227527            DEALLOCATE( kpcsflt_l )
    7523             CALL radiation_write_debug_log( 'End of aggregate csf' )
     7528            IF ( debug_output )  CALL debug_message( 'End of aggregate csf', 'info' )
    75247529           
    75257530        ENDIF
     
    75287533        CALL MPI_BARRIER( comm2d, ierr )
    75297534#endif
    7530         CALL radiation_write_debug_log( 'End of radiation_calc_svf (after mpi_barrier)' )
    7531 
    7532         RETURN
     7535        CALL location_message( 'calculating view factors for radiation interaction', 'finished' )
     7536
     7537        RETURN  !todo: remove
    75337538       
    75347539!        WRITE( message_string, * )  &
     
    84408445       INTEGER(iwp)                 :: nsurfl_from_file = 0
    84418446       INTEGER(iwp)                 :: nmrtbl_from_file = 0
    8442        
     8447
     8448
     8449       CALL location_message( 'reading view factors for radiation interaction', 'start' )
     8450
    84438451       DO  i = 0, io_blocks-1
    84448452          IF ( i == io_group )  THEN
     
    84848492                 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 )
    84858493             ELSE
    8486                  WRITE(message_string,*) '    Number of SVF, CSF, and nsurfl ',&
     8494                 WRITE(debug_string,*)   'Number of SVF, CSF, and nsurfl ',    &
    84878495                                         'to read', nsvfl, ncsfl,              &
    84888496                                         nsurfl_from_file
    8489                  CALL location_message( message_string, .TRUE. )
     8497                 IF ( debug_output )  CALL debug_message( debug_string, 'info' )
    84908498             ENDIF
    84918499             
     
    85168524                 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
    85178525             ELSE
    8518                  WRITE(message_string,*) '    Number of nmrtf to read ', nmrtf
    8519                  CALL location_message( message_string, .TRUE. )
     8526                 WRITE(debug_string,*) 'Number of nmrtf to read ', nmrtf
     8527                 IF ( debug_output )  CALL debug_message( debug_string, 'info' )
    85208528             ENDIF
    85218529             
     
    85788586       ENDDO
    85798587
     8588       CALL location_message( 'reading view factors for radiation interaction', 'finished' )
     8589
     8590
    85808591    END SUBROUTINE radiation_read_svf
    85818592
     
    85928603       
    85938604       INTEGER(iwp)        :: i
     8605
     8606
     8607       CALL location_message( 'writing view factors for radiation interaction', 'start' )
    85948608
    85958609       DO  i = 0, io_blocks-1
     
    86368650#endif
    86378651       ENDDO
     8652
     8653       CALL location_message( 'writing view factors for radiation interaction', 'finished' )
     8654
     8655
    86388656    END SUBROUTINE radiation_write_svf
    86398657
     
    87888806        INTEGER(iwp)                            :: iread, iwrite
    87898807        TYPE(t_csf), DIMENSION(:), POINTER      :: acsfnew
    8790         CHARACTER(100)                          :: msg
     8808
    87918809
    87928810        IF ( newsize == -1 )  THEN
     
    88528870        ncsfla = newsize
    88538871
    8854         WRITE(msg,'(A,2I12)') 'Grow acsf2:',ncsfl,ncsfla
    8855         CALL radiation_write_debug_log( msg )
     8872        IF ( debug_output )  THEN
     8873           WRITE( debug_string, '(A,2I12)' ) 'Grow acsf2:', ncsfl, ncsfla
     8874           CALL debug_message( debug_string, 'info' )
     8875        ENDIF
    88568876
    88578877    END SUBROUTINE merge_and_grow_csf
     
    1149011510 END SUBROUTINE radiation_rrd_local
    1149111511
    11492 !------------------------------------------------------------------------------!
    11493 ! Description:
    11494 ! ------------
    11495 !> Subroutine writes debug information
    11496 !------------------------------------------------------------------------------!
    11497  SUBROUTINE radiation_write_debug_log ( message )
    11498     !> it writes debug log with time stamp
    11499     CHARACTER(*)  :: message
    11500     CHARACTER(15) :: dtc
    11501     CHARACTER(8)  :: date
    11502     CHARACTER(10) :: time
    11503     CHARACTER(5)  :: zone
    11504     CALL date_and_time(date, time, zone)
    11505     dtc = date(7:8)//','//time(1:2)//':'//time(3:4)//':'//time(5:10)
    11506     WRITE(9,'(2A)') dtc, TRIM(message)
    11507     FLUSH(9)
    11508  END SUBROUTINE radiation_write_debug_log
    1150911512
    1151011513 END MODULE radiation_model_mod
  • palm/trunk/SOURCE/salsa_mod.f90

    r3876 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2018-2018 University of Helsinki
     17! Copyright 2018-2019 University of Helsinki
    1818! Copyright 1997-2019 Leibniz Universitaet Hannover
    1919!--------------------------------------------------------------------------------!
     
    2626! -----------------
    2727! $Id$
     28! Changes related to global restructuring of location messages and introduction
     29! of additional debug messages
     30!
     31! 3876 2019-04-08 18:41:49Z knoop
    2832! Introduced salsa_actions module interface
    2933!
     
    12901294    INTEGER(iwp) :: j   !<
    12911295
    1292     CALL location_message( 'initializing salsa (sectional aerosol module )', .TRUE. )
     1296    IF ( debug_output )  CALL debug_message( 'salsa_init', 'start' )
    12931297
    12941298    bin_low_limits = 0.0_wp
     
    14391443    ENDIF
    14401444
    1441     CALL location_message( 'finished', .TRUE. )
     1445    IF ( debug_output )  CALL debug_message( 'salsa_init', 'end' )
    14421446
    14431447 END SUBROUTINE salsa_init
     
    80878091!
    80888092!--          Subrange 2b:
     8093!--          todo: this information should go to HEADER/RUN_CONTROL, it doesn't belong to the job log,
     8094!--          and actually, aerosol_flux_mass_fracs_b is not used anywhere else except for this message,
     8095!--          hence, what do we need it for?
    80898096             IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp )  THEN
    8090                 CALL location_message( '   salsa_emission_setup: emissions are soluble!', .TRUE. )
     8097                CALL debug_message( '   salsa_emission_setup: emissions are soluble!', 'info' )
    80918098             ENDIF
    80928099
     
    86818688!
    86828689!--    Subrange 2b:
    8683        IF ( .NOT. no_insoluble )  THEN
    8684           CALL location_message( '    salsa_mass_flux: All emissions are soluble!', .TRUE. )
    8685        ENDIF
     8690!--          todo: this information should go to HEADER/RUN_CONTROL, it doesn't belong to the job log
     8691!        IF ( .NOT. no_insoluble )  THEN
     8692!           CALL location_message( '    salsa_mass_flux: All emissions are soluble!', .TRUE. )
     8693!        ENDIF
    86868694
    86878695    END SUBROUTINE set_mass_flux
     
    87768784          END SELECT
    87778785       ENDDO
    8778        IF ( SUM( emission_index_chem ) == 0 )  THEN
    8779           CALL location_message( '    salsa_gas_emission_setup: no gas emissions', .TRUE. )
    8780        ENDIF
     8786!--          todo: this information should go to HEADER/RUN_CONTROL, it doesn't belong to the job log
     8787!        IF ( SUM( emission_index_chem ) == 0 )  THEN
     8788!           CALL location_message( '    salsa_gas_emission_setup: no gas emissions', .TRUE. )
     8789!        ENDIF
    87818790!
    87828791!--    Inquire the fill value
  • palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

    r3881 r3885  
    2626! -----------------
    2727! $Id$
     28! Changes related to global restructuring of location messages and introduction
     29! of additional debug messages
     30!
     31! 3881 2019-04-10 09:31:22Z suehring
    2832! Assure that Obukhov length does not become zero
    2933!
     
    273277        ONLY:  air_chemistry, cloud_droplets,                                  &
    274278               constant_heatflux, constant_scalarflux,                         &
    275                constant_waterflux, coupling_mode, do_output_at_2m, humidity,   &
     279               constant_waterflux, coupling_mode,                              &
     280               debug_output, debug_string,                                     &
     281               do_output_at_2m, humidity,                                      &
    276282               ibc_e_b, ibc_pt_b, indoor_model, initializing_actions,          &
    277283               intermediate_timestep_count, intermediate_timestep_count_max,   &
     
    356362
    357363       IMPLICIT NONE
     364
     365
     366       IF ( debug_output )  CALL debug_message( 'surface_layer_fluxes', 'start' )
    358367
    359368       surf_vertical = .FALSE. !< flag indicating vertically orientated surface elements
     
    716725       ENDDO
    717726       mom_tke = .FALSE.
    718  
     727
     728       IF ( debug_output )  CALL debug_message( 'surface_layer_fluxes', 'end' )
    719729
    720730    END SUBROUTINE surface_layer_fluxes
     
    733743
    734744
    735        CALL location_message( 'initializing surface layer', .FALSE. )
     745       CALL location_message( 'initializing surface layer', 'start' )
    736746
    737747!
     
    744754       ENDIF
    745755
    746        CALL location_message( 'finished', .TRUE. )
     756       CALL location_message( 'initializing surface layer', 'finished' )
    747757
    748758    END SUBROUTINE init_surface_layer_fluxes
  • palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90

    r3775 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017 Leibniz Universitaet Hannover
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
    1818!------------------------------------------------------------------------------!
    1919!
     
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30!
    2731! removed unused variables
    2832!
     
    187191
    188192    USE control_parameters,                                                    &
    189         ONLY:  initializing_actions, num_mean_inflow_profiles, message_string, &
     193        ONLY:  debug_output,                                                   &
     194               debug_string,                                                   &
     195               initializing_actions,                                           &
     196               message_string,                                                 &
     197               num_mean_inflow_profiles,                                       &
    190198               syn_turb_gen
    191199
     
    10801088    REAL(wp) :: volume_flow_l   !< local mass flux through lateral boundary
    10811089
    1082 
     1090!
     1091!-- Debug location message
     1092    IF ( debug_output )  THEN
     1093       WRITE( debug_string, * ) 'stg_main'
     1094       CALL debug_message( debug_string, 'start' )
     1095    ENDIF
    10831096!
    10841097!-- Calculate time step which is needed for filter functions
     
    14221435!-- Finally, set time counter for calling STG to zero
    14231436    time_stg_call = 0.0_wp
    1424 
     1437!
     1438!-- Debug location message
     1439    IF ( debug_output )  THEN
     1440       WRITE( debug_string, * ) 'stg_main'
     1441       CALL debug_message( debug_string, 'end' )
     1442    ENDIF
    14251443
    14261444 END SUBROUTINE stg_main
     
    18251843
    18261844!
     1845!-- Debug location message
     1846    IF ( debug_output )  THEN
     1847       WRITE( debug_string, * ) 'stg_adjust'
     1848       CALL debug_message( debug_string, 'start' )
     1849    ENDIF
     1850!
    18271851!-- Compute mean boundary layer height according to Richardson-Bulk
    18281852!-- criterion using the inflow profiles. Further velocity scale as well as
     
    18561880!-- Reset time counter for controlling next adjustment to zero
    18571881    time_stg_adjust = 0.0_wp
    1858    
     1882!
     1883!-- Debug location message
     1884    IF ( debug_output )  THEN
     1885       WRITE( debug_string, * ) 'stg_adjust'
     1886       CALL debug_message( debug_string, 'end' )
     1887    ENDIF
    18591888   
    18601889 END SUBROUTINE stg_adjust
  • palm/trunk/SOURCE/time_integration.f90

    r3879 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3879 2019-04-08 20:25:23Z knoop
    2731! Moved wtm_forces to module_interface_actions
    2832!
     
    821825#endif
    822826
    823     CALL location_message( 'starting timestep-sequence', .TRUE. )
     827    CALL location_message( 'atmosphere (and/or ocean) time-stepping', 'start' )
    824828
    825829!
     
    18581862#endif
    18591863
    1860     CALL location_message( 'finished time-stepping', .TRUE. )
     1864    CALL location_message( 'atmosphere (and/or ocean) time-stepping', 'finished' )
    18611865
    18621866 END SUBROUTINE time_integration
  • palm/trunk/SOURCE/time_integration_spinup.f90

    r3766 r3885  
    2525! -----------------
    2626! $Id$
     27! Changes related to global restructuring of location messages and introduction
     28! of additional debug messages
     29!
     30! 3766 2019-02-26 16:23:41Z raasch
    2731! unused variable removed
    2832!
     
    257261    dt_3d   = dt_spinup
    258262
    259     CALL location_message( 'starting spinup-sequence', .TRUE. )
     263    CALL location_message( 'wall/soil spinup time-stepping', 'start' )
    260264!
    261265!-- Start of the time loop
     
    573577#endif
    574578
    575     CALL location_message( 'finished spinup-sequence', .TRUE. )
     579    CALL location_message( 'wall/soil spinup time-stepping', 'finished' )
    576580
    577581
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3882 r3885  
    2828! -----------------
    2929! $Id$
     30! Changes related to global restructuring of location messages and introduction
     31! of additional debug messages
     32!
     33! 3882 2019-04-10 11:08:06Z suehring
    3034! Avoid different type kinds
    3135! Move definition of building-surface properties from declaration block
     
    458462
    459463    USE control_parameters,                                                    &
    460         ONLY:  coupling_start_time, topography, dt_3d, humidity, indoor_model, &
     464        ONLY:  coupling_start_time, topography,                                &
     465               debug_output, debug_string,                                     &
     466               dt_3d, humidity, indoor_model,                                  &
    461467               intermediate_timestep_count, initializing_actions,              &
    462468               intermediate_timestep_count_max, simulated_time, end_time,      &
     
    976982        INTEGER(iwp) ::  l
    977983
    978         CALL location_message( 'initializing and allocating urban surfaces', .FALSE. )
     984        IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'start' )
    979985
    980986!
     
    13831389        ENDDO
    13841390
    1385         CALL location_message( 'finished', .TRUE. )
     1391        IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'end' )
    13861392       
    13871393    END SUBROUTINE usm_init_arrays
     
    34743480        INTEGER(iwp) ::  k, l, m            !< running indices
    34753481       
    3476         CALL location_message( '    initialization of wall surface model', .TRUE. )
     3482        IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'start' )
    34773483
    34783484!
     
    36603666
    36613667       
    3662         CALL location_message( '    wall structures filed out', .TRUE. )
    3663 
    3664         CALL location_message( '    initialization of wall surface model finished', .TRUE. )
     3668        IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'end' )
    36653669
    36663670    END SUBROUTINE usm_init_material_model
     
    37283732        REAL(wp)     ::  z_agl                        !< height above ground
    37293733
    3730         CALL location_message( 'initializing urban surface model', .FALSE. )
     3734        IF ( debug_output )  CALL debug_message( 'usm_init', 'start' )
    37313735
    37323736        CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
     
    51915195        CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
    51925196
    5193         CALL location_message( 'finished', .TRUE. )
     5197        IF ( debug_output )  CALL debug_message( 'usm_init', 'end' )
    51945198
    51955199    END SUBROUTINE usm_init
     
    52175221
    52185222        LOGICAL      :: spinup  !< if true, no calculation of window temperatures
     5223
     5224
     5225        IF ( debug_output )  THEN
     5226           WRITE( debug_string, * ) 'usm_material_heat_model | spinup: ', spinup
     5227           CALL debug_message( debug_string, 'start' )
     5228        ENDIF
    52195229
    52205230        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)
     
    55905600        !$OMP END PARALLEL
    55915601
     5602        IF ( debug_output )  THEN
     5603           WRITE( debug_string, * ) 'usm_material_heat_model | spinup: ', spinup
     5604           CALL debug_message( debug_string, 'end' )
     5605        ENDIF
     5606
    55925607    END SUBROUTINE usm_material_heat_model
    55935608
     
    56195634        LOGICAL :: conserve_water_content = .true.
    56205635
     5636
     5637        IF ( debug_output )  CALL debug_message( 'usm_green_heat_model', 'start' )
    56215638
    56225639        drho_l_lv = 1.0_wp / (rho_l * l_v)
     
    59495966        ENDDO
    59505967
     5968        IF ( debug_output )  CALL debug_message( 'usm_green_heat_model', 'end' )
     5969
    59515970    END SUBROUTINE usm_green_heat_model
    59525971
     
    69396958        REAL(wp)                                              :: wealbedo3, wethick3, snalbedo3, snthick3
    69406959
     6960
     6961        IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'start' )
    69416962!
    69426963!--     If building_pars or building_type are already read from static input
     
    74527473        ENDDO
    74537474
    7454        
    7455         WRITE(9,*) 'Urban surfaces read'
    7456         FLUSH(9)
    7457        
    7458         CALL location_message( '    types and parameters of urban surfaces read', .TRUE. )
     7475        IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'end' )
    74597476   
    74607477    END SUBROUTINE usm_read_urban_surface_types
     
    75137530
    75147531
     7532        IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'start' )
     7533
    75157534        DO  ii = 0, io_blocks-1
    75167535            IF ( ii == io_group )  THEN
     
    75677586        ENDDO
    75687587
    7569         CALL location_message( '    wall layer temperatures read', .TRUE. )
     7588        IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'end' )
    75707589
    75717590    END SUBROUTINE usm_read_wall_temperature
     
    76387657                     q_s             !< saturation specific humidity
    76397658
     7659
     7660        IF ( debug_output )  THEN
     7661           WRITE( debug_string, * ) 'usm_surface_energy_balance | spinup: ', spinup
     7662           CALL debug_message( debug_string, 'start' )
     7663        ENDIF
    76407664!
    76417665!--     Index offset of surface element point with respect to adjoining
     
    86398663!
    86408664!        END SUBROUTINE calc_q_surface_usm
    8641        
     8665
     8666        IF ( debug_output )  THEN
     8667           WRITE( debug_string, * ) 'usm_surface_energy_balance | spinup: ', spinup
     8668           CALL debug_message( debug_string, 'end' )
     8669        ENDIF
     8670
    86428671     END SUBROUTINE usm_surface_energy_balance
    86438672 
  • palm/trunk/SOURCE/virtual_flight_mod.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! variables documented
    2832!
     
    104108 
    105109    USE control_parameters,                                                    &
    106         ONLY:  fl_max, num_leg, num_var_fl, num_var_fl_user, virtual_flight
     110        ONLY:  debug_output, fl_max, num_leg, num_var_fl, num_var_fl_user, virtual_flight
    107111 
    108112    USE kinds
     
    332336
    333337       REAL(wp) ::  distance  !< distance between start and end position of a flight leg
     338
     339
     340       IF ( debug_output )  CALL debug_message( 'flight_init', 'start' )
    334341!
    335342!--    Determine the number of flight legs
     
    407414       sensor_l = 0.0_wp
    408415       sensor   = 0.0_wp
     416
     417       IF ( debug_output )  CALL debug_message( 'flight_init', 'end' )
    409418
    410419    END SUBROUTINE flight_init
  • palm/trunk/SOURCE/wind_turbine_model_mod.f90

    r3875 r3885  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2009-2018 Carl von Ossietzky Universitaet Oldenburg
     17! Copyright 2009-2019 Carl von Ossietzky Universitaet Oldenburg
    1818! Copyright 1997-2019 Leibniz Universitaet Hannover
    1919!------------------------------------------------------------------------------!
     
    2626! -----------------
    2727! $Id$
     28! Changes related to global restructuring of location messages and introduction
     29! of additional debug messages
     30!
     31! 3875 2019-04-08 17:35:12Z knoop
    2832! Addaped wtm_tendency to fit the module actions interface
    2933!
     
    197201
    198202    USE control_parameters,                                                    &
    199         ONLY:  coupling_char, dt_3d, dz, message_string, simulated_time,       &
     203        ONLY:  coupling_char,                                                  &
     204               debug_output,                                                   &
     205               dt_3d, dz, message_string, simulated_time,                      &
    200206               wind_turbine, initializing_actions
    201207
     
    984990       INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: index_nact       !<
    985991       
    986        CALL location_message( 'initializing wind turbine model', .FALSE. )
     992       IF ( debug_output )  CALL debug_message( 'wtm_init', 'start' )
    987993       
    988994       ALLOCATE( index_nacb(1:nturbines) )
     
    13411347       CALL wtm_read_blade_tables
    13421348
    1343        CALL location_message( 'finished', .TRUE. )
     1349       IF ( debug_output )  CALL debug_message( 'wtm_init', 'end' )
    13441350 
    13451351    END SUBROUTINE wtm_init
Note: See TracChangeset for help on using the changeset viewer.