Changeset 3987 for palm


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

clean up location, debug and error messages

Location:
palm/trunk/SOURCE
Files:
17 edited

Legend:

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

    r3943 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3943 2019-05-02 09:50:41Z maronga
    2730! Added output of qsws for green roofs.
    2831!
     
    306309        ONLY:  data_output_2d_on_each_pe,                                      &
    307310               data_output_xy, data_output_xz, data_output_yz,                 &
    308                debug_output, debug_string,                                     &
     311               debug_output_timestep,                                          &
    309312               do2d,                                                           &
    310313               do2d_xy_last_time, do2d_xy_time_count,                          &
     
    404407
    405408
    406     IF ( debug_output )  THEN
    407        WRITE( debug_string, * ) 'data_output_2d'
    408        CALL debug_message( debug_string, 'start' )
    409     ENDIF
     409    IF ( debug_output_timestep )  CALL debug_message( 'data_output_2d', 'start' )
    410410!
    411411!-- Immediate return, if no output is requested (no respective sections
     
    22842284    CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
    22852285
    2286     IF ( debug_output )  THEN
    2287        WRITE( debug_string, * ) 'data_output_2d'
    2288        CALL debug_message( debug_string, 'end' )
    2289     ENDIF
     2286    IF ( debug_output_timestep )  CALL debug_message( 'data_output_2d', 'end' )
     2287
    22902288
    22912289 END SUBROUTINE data_output_2d
  • palm/trunk/SOURCE/data_output_3d.f90

    r3885 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    262265
    263266    USE control_parameters,                                                    &
    264         ONLY:  debug_output, debug_string,                                     &
     267        ONLY:  debug_output_timestep,                                          &
    265268               do3d, do3d_no, do3d_time_count, io_blocks, io_group,            &
    266269               land_surface, message_string, ntdim_3d, nz_do3d, psolver,       &
     
    341344    IF ( do3d_no(av) == 0 )  RETURN
    342345
    343     IF ( debug_output )  THEN
    344        WRITE( debug_string, * ) 'data_output_3d'
    345        CALL debug_message( debug_string, 'start' )
    346     ENDIF
     346    IF ( debug_output_timestep )  CALL debug_message( 'data_output_3d', 'start' )
    347347
    348348    CALL cpu_log (log_point(14),'data_output_3d','start')
     
    876876    CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
    877877
    878     IF ( debug_output )  THEN
    879        WRITE( debug_string, * ) 'data_output_3d'
    880        CALL debug_message( debug_string, 'end' )
    881     ENDIF
     878    IF ( debug_output_timestep )  CALL debug_message( 'data_output_3d', 'end' )
     879
    882880
    883881 END SUBROUTINE data_output_3d
  • palm/trunk/SOURCE/init_3d_model.f90

    r3939 r3987  
    2525! -----------------
    2626! $Id$
     27! Convert most location messages to debug messages to reduce output in
     28! job logfile to a minimum
     29!
     30!
    2731! unused variable removed
    2832!
     
    737741    INTEGER(iwp) ::  nz_s_shift_l !< topography-top index on scalar-grid, used to vertically shift initial profiles
    738742
    739     CALL location_message( 'init_3d_model', 'start' )
    740     CALL location_message( 'allocating arrays', 'start' )
     743
     744    CALL location_message( 'model initialization', 'start' )
     745
     746    IF ( debug_output )  CALL debug_message( 'allocating arrays', 'start' )
    741747!
    742748!-- Allocate arrays
     
    10871093    intermediate_timestep_count = 0  ! needed when simulated_time = 0.0
    10881094       
    1089     CALL location_message( 'allocating arrays', 'finished' )
     1095    IF ( debug_output )  CALL debug_message( 'allocating arrays', 'end' )
    10901096
    10911097!
     
    11101116!--    Initialization with provided input data derived from larger-scale model
    11111117       IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
    1112           CALL location_message( 'initializing with INIFOR', 'start' )
     1118          IF ( debug_output )  CALL debug_message( 'initializing with INIFOR', 'start' )
    11131119!
    11141120!--       Read initial 1D profiles or 3D data from NetCDF file, depending
     
    13131319          CALL init_surfaces
    13141320
    1315           CALL location_message( 'initializing with INIFOR', 'finished' )
     1321          IF ( debug_output )  CALL debug_message( 'initializing with INIFOR', 'end' )
    13161322!
    13171323!--    Initialization via computed 1D-model profiles
    13181324       ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
    13191325
    1320           CALL location_message( 'initializing with 1D model profiles', 'start' )
     1326          IF ( debug_output )  CALL debug_message( 'initializing with 1D model profiles', 'start' )
    13211327!
    13221328!--       Use solutions of the 1D model as initial profiles,
     
    13801386          CALL init_surfaces
    13811387
    1382           CALL location_message( 'initializing with 1D model profiles', 'finished' )
     1388          IF ( debug_output )  CALL debug_message( 'initializing with 1D model profiles', 'end' )
    13831389
    13841390       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )    &
    13851391       THEN
    13861392
    1387           CALL location_message( 'initializing with constant profiles', 'start' )
     1393          IF ( debug_output )  CALL debug_message( 'initializing with constant profiles', 'start' )
    13881394
    13891395!
     
    14481454          CALL init_surfaces
    14491455         
    1450           CALL location_message( 'initializing with constant profiles', 'finished' )
     1456          IF ( debug_output )  CALL debug_message( 'initializing with constant profiles', 'end' )
    14511457
    14521458       ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 )                  &
    14531459       THEN
    14541460
    1455           CALL location_message( 'initializing by user', 'start' )
     1461          IF ( debug_output )  CALL debug_message( 'initializing by user', 'start' )
    14561462!
    14571463!--       Pre-initialize surface variables, i.e. setting start- and end-indices
     
    14631469          CALL user_init_3d_model
    14641470
    1465           CALL location_message( 'initializing by user', 'finished' )
    1466 
    1467        ENDIF
    1468 
    1469        CALL location_message( 'initializing statistics, boundary conditions, etc.', 'start' )
     1471          IF ( debug_output )  CALL debug_message( 'initializing by user', 'end' )
     1472
     1473       ENDIF
     1474
     1475       IF ( debug_output )  CALL debug_message( 'initializing statistics, boundary conditions, etc.', 'start' )
    14701476
    14711477!
     
    16011607       ENDIF       
    16021608
    1603        CALL location_message( 'initializing statistics, boundary conditions, etc.', 'finished' )
     1609       IF ( debug_output )  CALL debug_message( 'initializing statistics, boundary conditions, etc.', 'end' )
    16041610
    16051611    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.         &
     
    16071613    THEN
    16081614
    1609        CALL location_message( 'initializing in case of restart / cyclic_fill', 'start' )
     1615       IF ( debug_output )  CALL debug_message( 'initializing in case of restart / cyclic_fill', 'start' )
    16101616!
    16111617!--    Initialize surface elements and its attributes, e.g. heat- and
     
    18671873       IF ( passive_scalar )  ts_m  = 0.0_wp
    18681874
    1869        CALL location_message( 'initializing in case of restart / cyclic_fill', 'finished' )
     1875       IF ( debug_output )  CALL debug_message( 'initializing in case of restart / cyclic_fill', 'end' )
    18701876
    18711877    ELSE
     
    22282234         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
    22292235
     2236       IF ( debug_output )  CALL debug_message( 'creating disturbances + applying pressure solver', 'start' )
    22302237!
    22312238!--    Needed for both disturb_field and pres
     
    22352242!$ACC COPY(v(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
    22362243
    2237        CALL location_message( 'creating initial disturbances', 'start' )
    22382244       CALL disturb_field( 'u', tend, u )
    22392245       CALL disturb_field( 'v', tend, v )
    2240        CALL location_message( 'creating initial disturbances', 'finished' )
    22412246
    22422247!$ACC DATA &
     
    22552260!$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns))
    22562261
    2257        CALL location_message( 'applying pressure solver', 'start' )
    22582262       n_sor = nsor_ini
    22592263       CALL pres
    22602264       n_sor = nsor
    2261        CALL location_message( 'applying pressure solver', 'finished' )
    22622265
    22632266!$ACC END DATA
    22642267!$ACC END DATA
     2268
     2269       IF ( debug_output )  CALL debug_message( 'creating disturbances + applying pressure solver', 'end' )
    22652270
    22662271    ENDIF
     
    24662471
    24672472
    2468     CALL location_message( 'init_3d_model', 'finished' )
     2473    CALL location_message( 'model initialization', 'finished' )
    24692474
    24702475 END SUBROUTINE init_3d_model
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r3964 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3964 2019-05-09 09:48:32Z suehring
    2730! In a nested child domain, distinguish between soil moisture and temperature
    2831! initialization from parent via dynamic input file. Further, initialize soil
     
    565568    USE control_parameters,                                                    &
    566569        ONLY:  cloud_droplets, coupling_start_time,                            &
    567                debug_output, debug_string,                                     &
     570               debug_output, debug_output_timestep, debug_string,              &
    568571               dt_3d,                                                          &
    569572               end_time, humidity, intermediate_timestep_count,                &
    570573               initializing_actions, intermediate_timestep_count_max,          &
    571                land_surface, max_masks, pt_surface,             &
     574               land_surface, max_masks, pt_surface,                            &
    572575               rho_surface, spinup, spinup_pt_mean, spinup_time,               &
    573576               surface_pressure, timestep_scheme, tsc,                         &
     
    19081911    TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
    19091912
    1910 !
    1911 !-- Debug location message
    1912     IF ( debug_output )  THEN
     1913
     1914    IF ( debug_output_timestep )  THEN
    19131915       WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l
    19141916       CALL debug_message( debug_string, 'start' )
     
    24722474    IF ( horizontal  .AND.  .NOT. constant_roughness )  CALL calc_z0_water_surface
    24732475   
    2474     IF ( debug_output )  THEN
     2476    IF ( debug_output_timestep )  THEN
    24752477       WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l
    24762478       CALL debug_message( debug_string, 'end' )
     
    53385340
    53395341
    5340        IF ( debug_output )  THEN
     5342       IF ( debug_output_timestep )  THEN
    53415343          WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
    53425344          CALL debug_message( debug_string, 'start' )
     
    56405642!
    56415643!--    Debug location message
    5642        IF ( debug_output )  THEN
     5644       IF ( debug_output_timestep )  THEN
    56435645          WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
    56445646          CALL debug_message( debug_string, 'end' )
  • palm/trunk/SOURCE/message.f90

    r3885 r3987  
    2525! -----------------
    2626! $Id$
     27! Improved formatting of job logfile output,
     28! changed output of DEBUG file
     29!
     30! 3885 2019-04-11 11:29:34Z kanani
    2731! Changes related to global restructuring of location messages and introduction
    2832! of additional debug messages
     
    123127    CHARACTER(LEN=*)   ::  routine_name                  !<
    124128    CHARACTER(LEN=200) ::  header_string                 !<
     129    CHARACTER(LEN=200) ::  header_string_2               !< for message ID and routine name
    125130    CHARACTER(LEN=200) ::  information_string_1          !<
    126131    CHARACTER(LEN=200) ::  information_string_2          !<
     
    151156    IF ( message_level == 0 )  THEN
    152157       header_string = '--- informative message' // TRIM(nest_string) //       &
    153                        ' ---  ID:'
     158                       ' ---'
    154159    ELSEIF ( message_level == 1 )  THEN
    155        header_string = '+++ warning message' // TRIM(nest_string) // ' ---  ID:'
     160       header_string = '+++ warning message' // TRIM(nest_string) // ' ---'
    156161    ELSEIF ( message_level == 2 )  THEN
    157        header_string = '+++ error message' // TRIM(nest_string) // ' ---  ID:'
     162       header_string = '+++ error message' // TRIM(nest_string) // ' ---'
    158163    ELSE
    159164       WRITE( header_string,'(A,I2)' )  '+++ unknown message level' //         &
     
    164169!
    165170!-- Add the message identifier and the generating routine
    166     header_string = TRIM( header_string ) // ' ' // message_identifier // &
    167                     '   generated by routine: ' // TRIM( routine_name )
     171    header_string_2 = 'ID: ' // message_identifier // &
     172                      '  generated by routine: ' // TRIM( routine_name )
    168173 
    169174    information_string_1 = 'Further information can be found at'
     
    203208!
    204209!--       Output on stdout
    205           WRITE( *, '(6X,A)' )  TRIM( header_string )
     210          WRITE( *, '(16X,A)' )  TRIM( header_string )
     211          WRITE( *, '(20X,A)' )  TRIM( header_string_2 )
    206212!
    207213!--       Cut message string into pieces and output one piece per line.
     
    210216          i = INDEX( message_string, '&' )
    211217          DO WHILE ( i /= 0 )
    212              WRITE( *, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
     218             WRITE( *, '(20X,A)' )  ADJUSTL( message_string(1:i-1) )
    213219             message_string = ADJUSTL( message_string(i+1:) )
    214220             i = INDEX( message_string, '&' )
    215221          ENDDO
    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)' )  ''
     222          WRITE( *, '(20X,A)' )  ''
     223          WRITE( *, '(20X,A)' )  TRIM( message_string )
     224          WRITE( *, '(20X,A)' )  ''
     225          WRITE( *, '(20X,A)' )  TRIM( information_string_1 )
     226          WRITE( *, '(20X,A)' )  TRIM( information_string_2 )
     227          WRITE( *, '(20X,A)' )  ''
    222228
    223229       ELSE
     
    286292
    287293    CHARACTER(LEN=*)  ::  location      !< text to be output on stdout
     294    CHARACTER(LEN=60) ::  location_string = ' '  !<
    288295    CHARACTER(LEN=*)  ::  message_type  !< attribute marking 'start' or 'end' of routine
    289296    CHARACTER(LEN=11) ::  message_type_string = ' '  !<
     
    305312       IF ( TRIM( message_type ) == 'finished' )  WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
    306313!
     314!--    Write dummy location_string in order to allow left-alignment of text despite the fixed (=A60)
     315!--    format.
     316       WRITE( location_string, * )  TRIM( location )
     317!
    307318!--    Write and flush debug location or info message to file
    308        WRITE( OUTPUT_UNIT, 200 )  TRIM( message_type_string ), TRIM( location ), TRIM( system_time )
     319       WRITE( OUTPUT_UNIT, 200 )  TRIM( message_type_string ), location_string, TRIM( system_time )
    309320       FLUSH( OUTPUT_UNIT )
    310321!
    311322!--    Message formats
    312 200    FORMAT ( 3X, A, '  ', A, ' | System time: ', A )
     323200    FORMAT ( 3X, A, ' ', A60, ' | System time: ', A )
    313324
    314325    ENDIF
     
    328339
    329340    USE control_parameters,                                                                        &
    330         ONLY:  current_timestep_number
     341        ONLY:  time_since_reference_point
    331342
    332343    IMPLICIT NONE
     
    353364!
    354365!-- 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 )
     366    WRITE( debug_output_unit, 201 )    TRIM( system_time ), time_since_reference_point, TRIM( message_type_string ), TRIM( debug_string )
    356367    FLUSH( debug_output_unit )
    357368
    358369!
    359370!-- Message formats
    360 201 FORMAT ( 'System time: ', A, ' | timestep: ', I6, ' | ', A, ' ', A )
     371201 FORMAT ( 'System time: ', A, ' | simulated time (s): ', F12.3, ' | ', A, ' ', A )
    361372
    362373
  • palm/trunk/SOURCE/module_interface.f90

    r3956 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce switchable DEBUG file output via debug_message routine
     28!
     29! 3956 2019-05-07 12:32:52Z monakurppa
    2730! - Added calls for salsa_non_advective_processes and
    2831!   salsa_exchange_horiz_bounds
     
    122125!-- ToDo: move all of them to respective module or a dedicated central module
    123126    USE control_parameters,                                                    &
    124         ONLY:  biometeorology,                                                 &
    125                air_chemistry,                                                  &
     127        ONLY:  air_chemistry,                                                  &
     128               biometeorology,                                                 &
     129               debug_output,                                                   &
     130               debug_output_timestep,                                          &
    126131               indoor_model,                                                   &
    127132               land_surface,                                                   &
     
    539544
    540545
     546    IF ( debug_output )  CALL debug_message( 'reading module-specific parameters', 'start' )
     547
    541548    CALL bio_parin
    542549    CALL bcm_parin
     
    563570    CALL package_parin ! ToDo: deprecated, needs to be dissolved
    564571
     572    IF ( debug_output )  CALL debug_message( 'reading module-specific parameters', 'end' )
     573
    565574
    566575 END SUBROUTINE module_interface_parin
     
    574583 SUBROUTINE module_interface_check_parameters
    575584
     585
     586    IF ( debug_output )  CALL debug_message( 'checking module-specific parameters', 'start' )
    576587
    577588    IF ( bulk_cloud_model )     CALL bcm_check_parameters
     
    594605    IF ( user_module_enabled )  CALL user_check_parameters
    595606
     607    IF ( debug_output )  CALL debug_message( 'checking module-specific parameters', 'end' )
     608
    596609
    597610 END SUBROUTINE module_interface_check_parameters
     
    612625
    613626
     627    IF ( debug_output )  CALL debug_message( 'checking module-specific data output ts', 'start' )
     628
    614629    IF ( radiation )  THEN
    615630       CALL radiation_check_data_output_ts( dots_max, dots_num )
     
    619634       CALL user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
    620635    ENDIF
     636
     637    IF ( debug_output )  CALL debug_message( 'checking module-specific data output ts', 'end' )
    621638
    622639
     
    638655    CHARACTER (LEN=*), INTENT(OUT)   ::  dopr_unit !< local value of dopr_unit
    639656
     657
     658    IF ( debug_output )  CALL debug_message( 'checking module-specific data output pr', 'start' )
     659
    640660    IF ( unit == 'illegal' .AND.  bulk_cloud_model )  THEN
    641661       CALL bcm_check_data_output_pr( variable, var_count, unit, dopr_unit )
     
    670690       CALL user_check_data_output_pr( variable, var_count, unit, dopr_unit )
    671691    ENDIF
     692
     693    IF ( debug_output )  CALL debug_message( 'checking module-specific data output pr', 'end' )
    672694
    673695
     
    690712    INTEGER(iwp),      INTENT(IN)    :: k         !< ToDo: remove dummy argument, instead pass string from data_output
    691713
     714
     715    IF ( debug_output )  CALL debug_message( 'checking module-specific data output 2d/3d', 'start' )
     716
    692717    IF ( unit == 'illegal'  .AND.  biometeorology )  THEN
    693718       CALL bio_check_data_output( variable, unit, i, j, ilen, k )
     
    742767    ENDIF
    743768
     769    IF ( debug_output )  CALL debug_message( 'checking module-specific data output 2d/3d', 'end' )
     770
    744771
    745772 END SUBROUTINE module_interface_check_data_output
     
    757784    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
    758785    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
     786
     787
     788    IF ( debug_output )  CALL debug_message( 'initializing module-specific masks', 'start' )
    759789
    760790    IF ( unit == 'illegal'  .AND.  air_chemistry                               &
     
    775805       CALL user_check_data_output( variable, unit )
    776806    ENDIF
     807
     808    IF ( debug_output )  CALL debug_message( 'initializing module-specific masks', 'end' )
    777809
    778810
     
    795827    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y !< netcdf dimension in y-direction
    796828    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z !< netcdf dimension in z-direction
     829
     830
     831    IF ( debug_output )  CALL debug_message( 'defining module-specific netcdf grids', 'start' )
    797832!
    798833!-- As long as no action is done in this subroutine, initialize strings with
     
    806841    IF ( var == ' ' )  RETURN
    807842
     843    IF ( debug_output )  CALL debug_message( 'defining module-specific netcdf grids', 'end' )
     844
     845
    808846 END SUBROUTINE module_interface_define_netcdf_grid
    809847
     
    817855
    818856
    819     CALL location_message( 'initializing module-specific arrays', 'start' )
     857    IF ( debug_output )  CALL debug_message( 'initializing module-specific arrays', 'start' )
    820858
    821859    IF ( bulk_cloud_model    )  CALL bcm_init_arrays
     
    830868    IF ( user_module_enabled )  CALL user_init_arrays
    831869
    832     CALL location_message( 'initializing module-specific arrays', 'finished' )
     870    IF ( debug_output )  CALL debug_message( 'initializing module-specific arrays', 'end' )
    833871
    834872
     
    844882
    845883
    846     CALL location_message( 'initializing module features', 'start' )
     884    IF ( debug_output )  CALL debug_message( 'module-specific initialization', 'start' )
    847885
    848886    IF ( biometeorology      )  CALL bio_init
     
    864902    IF ( user_module_enabled )  CALL user_init
    865903
    866     CALL location_message( 'initializing module features', 'finished' )
     904    IF ( debug_output )  CALL debug_message( 'module-specific initialization', 'end' )
    867905
    868906
     
    878916
    879917
     918    IF ( debug_output )  CALL debug_message( 'module-specific post-initialization checks', 'start' )
     919
    880920    IF ( biometeorology      )  CALL bio_init_checks
    881921
     922    IF ( debug_output )  CALL debug_message( 'module-specific post-initialization checks', 'end' )
     923
    882924
    883925 END SUBROUTINE module_interface_init_checks
     
    894936    INTEGER(iwp), INTENT(IN) ::  io  !< unit of the output file
    895937
     938
     939    IF ( debug_output )  CALL debug_message( 'module-specific header output', 'start' )
    896940
    897941    IF ( biometeorology      )  CALL bio_header ( io )
     
    911955    IF ( user_module_enabled )  CALL user_header( io )
    912956
     957    IF ( debug_output )  CALL debug_message( 'module-specific header output', 'end' )
     958
    913959
    914960 END SUBROUTINE module_interface_header
     
    9661012! Description:
    9671013! ------------
    968 !> Compute module-specificc non_advective_processes (vector-optimized)
     1014!> Compute module-specific non_advective_processes (vector-optimized)
    9691015!------------------------------------------------------------------------------!
    9701016 SUBROUTINE module_interface_non_advective_processes()
     
    10061052
    10071053
     1054    IF ( debug_output_timestep )  CALL debug_message( 'module-specific exchange_horiz', 'start' )
     1055
    10081056    IF ( bulk_cloud_model    )  CALL bcm_exchange_horiz()
    10091057    IF ( air_chemistry       )  CALL chem_exchange_horiz_bounds()
    10101058    IF ( salsa               )  CALL salsa_exchange_horiz_bounds()
     1059
     1060    IF ( debug_output_timestep )  CALL debug_message( 'module-specific exchange_horiz', 'end' )
     1061
    10111062
    10121063 END SUBROUTINE module_interface_exchange_horiz
     
    10641115
    10651116    INTEGER(iwp), INTENT(IN) :: swap_mode !< determines procedure of pointer swap
     1117
     1118
     1119    IF ( debug_output_timestep )  CALL debug_message( 'module-specific swap timelevel', 'start' )
    10661120
    10671121    IF ( bulk_cloud_model    )  CALL bcm_swap_timelevel( swap_mode )
     
    10731127    IF ( urban_surface       )  CALL usm_swap_timelevel( swap_mode )
    10741128
     1129    IF ( debug_output_timestep )  CALL debug_message( 'module-specific swap timelevel', 'end' )
     1130
    10751131
    10761132 END SUBROUTINE module_interface_swap_timelevel
     
    10881144    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< averaging interface mode
    10891145    CHARACTER (LEN=*), INTENT(IN) ::  variable !< variable name
     1146
     1147
     1148    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data averaging', 'start' )
    10901149
    10911150    IF ( biometeorology      )  CALL bio_3d_data_averaging( mode, variable )
     
    11001159    IF ( user_module_enabled )  CALL user_3d_data_averaging( mode, variable )
    11011160
     1161    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data averaging', 'end' )
     1162
    11021163
    11031164 END SUBROUTINE module_interface_3d_data_averaging
     
    11261187
    11271188
     1189    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 2d data output', 'start' )
     1190
    11281191    IF ( .NOT. found  .AND.  biometeorology )  THEN
    11291192       CALL bio_data_output_2d(                                                &
     
    11791242            )
    11801243    ENDIF
     1244
     1245    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 2d data output', 'end' )
     1246
    11811247
    11821248 END SUBROUTINE module_interface_data_output_2d
     
    12041270
    12051271
     1272    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data output', 'start' )
     1273
    12061274    IF ( .NOT. found  .AND.  biometeorology )  THEN
    12071275       CALL bio_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
     
    12541322    ENDIF
    12551323
     1324    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data output', 'end' )
     1325
    12561326
    12571327 END SUBROUTINE module_interface_data_output_3d
     
    12711341    INTEGER(iwp),      INTENT(IN) ::  dots_max !< maximum number of timeseries
    12721342
     1343
     1344    IF ( debug_output_timestep )  CALL debug_message( 'module-specific statistics', 'start' )
     1345
    12731346    IF ( gust_module_enabled )  CALL gust_statistics( mode, sr, tn, dots_max )
    12741347    IF ( air_chemistry       )  CALL chem_statistics( mode, sr, tn )
    12751348    IF ( user_module_enabled )  CALL user_statistics( mode, sr, tn )
    12761349
     1350    IF ( debug_output_timestep )  CALL debug_message( 'module-specific statistics', 'end' )
     1351
    12771352
    12781353 END SUBROUTINE module_interface_statistics
     
    12881363
    12891364    LOGICAL, INTENT(INOUT) ::  found    !< flag if variable was found
     1365
     1366
     1367    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'start' )
    12901368
    12911369    IF ( .NOT. found )  CALL bio_rrd_global( found ) ! ToDo: change interface to pass variable
     
    12991377    IF ( .NOT. found )  CALL user_rrd_global( found ) ! ToDo: change interface to pass variable
    13001378
     1379    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'end' )
     1380
    13011381
    13021382 END SUBROUTINE module_interface_rrd_global
     
    13101390 SUBROUTINE module_interface_wrd_global
    13111391
     1392
     1393    IF ( debug_output )  CALL debug_message( 'module-specific write global restart data', 'start' )
    13121394
    13131395    IF ( biometeorology )       CALL bio_wrd_global
     
    13201402    IF ( surface_output )       CALL surface_data_output_wrd_global
    13211403    IF ( user_module_enabled )  CALL user_wrd_global
     1404
     1405    IF ( debug_output )  CALL debug_message( 'module-specific write global restart data', 'end' )
    13221406
    13231407
     
    13571441
    13581442
     1443    IF ( debug_output )  CALL debug_message( 'module-specific read local restart data', 'start' )
     1444
    13591445    IF ( .NOT. found ) CALL bio_rrd_local(                                     &
    13601446                               found                                           &
     
    14451531                            ) ! ToDo: change interface to pass variable
    14461532
     1533    IF ( debug_output )  CALL debug_message( 'module-specific read local restart data', 'end' )
     1534
    14471535
    14481536 END SUBROUTINE module_interface_rrd_local
     
    14561544 SUBROUTINE module_interface_wrd_local
    14571545
     1546
     1547    IF ( debug_output )  CALL debug_message( 'module-specific write local restart data', 'start' )
    14581548
    14591549    IF ( biometeorology )       CALL bio_wrd_local
     
    14691559    IF ( user_module_enabled )  CALL user_wrd_local
    14701560
     1561    IF ( debug_output )  CALL debug_message( 'module-specific write local restart data', 'end' )
     1562
    14711563
    14721564 END SUBROUTINE module_interface_wrd_local
     
    14801572 SUBROUTINE module_interface_last_actions
    14811573
     1574
     1575    IF ( debug_output )  CALL debug_message( 'module-specific last actions', 'start' )
    14821576
    14831577    IF ( virtual_measurement )  CALL vm_last_actions
    14841578    IF ( user_module_enabled )  CALL user_last_actions
    14851579
     1580    IF ( debug_output )  CALL debug_message( 'module-specific last actions', 'end' )
     1581
    14861582
    14871583 END SUBROUTINE module_interface_last_actions
  • palm/trunk/SOURCE/modules.f90

    r3885 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    13241327    LOGICAL ::  data_output_2d_on_each_pe = .TRUE.               !< namelist parameter
    13251328    LOGICAL ::  debug_output = .FALSE.                           !< namelist parameter
     1329    LOGICAL ::  debug_output_timestep = .FALSE.                  !< namelist parameter
    13261330    LOGICAL ::  disturbance_created = .FALSE.                    !< flow disturbance imposed?
    13271331    LOGICAL ::  do2d_at_begin = .FALSE.                          !< namelist parameter
  • palm/trunk/SOURCE/multi_agent_system_mod.f90

    r3885 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    114117    USE control_parameters,                                                    &
    115118        ONLY:  biometeorology,                                                 &
    116                debug_output,                                                   &
    117                debug_string,                                                   &
     119               debug_output_timestep,                                          &
    118120               dt_3d,                                                          &
    119121               dt_write_agent_data,                                            &
     
    396398    LOGICAL       ::  first_loop_stride   !< flag for first loop stride of agent sub-timesteps
    397399    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
     400
     401
     402    IF ( debug_output_timestep )  CALL debug_message( 'multi_agent_system', 'start' )
    404403
    405404    CALL cpu_log( log_point(9), 'mas', 'start' )
     
    622621
    623622    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
     623
     624    IF ( debug_output_timestep )  CALL debug_message( 'multi_agent_system', 'end' )
     625
    630626
    631627 END SUBROUTINE multi_agent_system
  • palm/trunk/SOURCE/nesting_offl_mod.f90

    r3964 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3964 2019-05-09 09:48:32Z suehring
    2730! Ensure that veloctiy term in calculation of bulk Richardson number does not
    2831! become zero
     
    8588        ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r,  &
    8689               bc_dirichlet_s, dt_3d, dz, constant_diffusion,                  &
    87                debug_output, debug_string, humidity, initializing_actions,     &
     90               debug_output_timestep,                                          &
     91               humidity,                                                       &
     92               initializing_actions,                                           &
    8893               message_string, nesting_offline, neutral, passive_scalar,       &
    8994               rans_mode, rans_tke_e, time_since_reference_point, volume_flow
     
    167172       REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !< local volume flow
    168173
    169 !
    170 !--    Debug location message
    171        IF ( debug_output )  THEN
    172           WRITE( debug_string, * ) 'nesting_offl_mass_conservation'
    173           CALL debug_message( debug_string, 'start' )
    174        ENDIF
    175        
     174
     175       IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_mass_conservation', 'start' )
     176
    176177       CALL  cpu_log( log_point(58), 'offline nesting', 'start' )
    177178       
     
    249250       
    250251       CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
    251 !
    252 !--    Debug location message
    253        IF ( debug_output )  THEN
    254           WRITE( debug_string, * ) 'nesting_offl_mass_conservation'
    255           CALL debug_message( debug_string, 'end' )
    256        ENDIF
     252
     253       IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_mass_conservation', 'end' )
    257254
    258255    END SUBROUTINE nesting_offl_mass_conservation
     
    287284       REAL(wp), DIMENSION(nzb:nzt+1) ::  v_ref_l  !< reference profile for v-component on subdomain
    288285       
    289 !
    290 !--    Debug location message
    291        IF ( debug_output )  THEN
    292           WRITE( debug_string, * ) 'nesting_offl_bc'
    293           CALL debug_message( debug_string, 'start' )
    294        ENDIF
     286
     287       IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'start' )
    295288
    296289       CALL  cpu_log( log_point(58), 'offline nesting', 'start' )     
     
    828821   
    829822       CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
    830 !
    831 !--    Debug location message
    832        IF ( debug_output )  THEN
    833           WRITE( debug_string, * ) 'nesting_offl_bc'
    834           CALL debug_message( debug_string, 'end' )
    835        ENDIF
     823
     824       IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'end' )
     825
    836826
    837827    END SUBROUTINE nesting_offl_bc
  • palm/trunk/SOURCE/netcdf_data_input_mod.f90

    r3976 r3987  
    2525! -----------------
    2626! $Id$
     27! Remove single location message
     28!
     29! 3976 2019-05-15 11:02:34Z hellstea
    2730! Remove unused variables from last commit
    2831!
     
    329332!> @todo - depreciate subroutines get_variable_4d_to_3d_real and
    330333!>         get_variable_5d_to_4d_real (ecc)
     334!> @todo - introduce useful debug_message(s)
    331335!------------------------------------------------------------------------------!
    332336 MODULE netcdf_data_input_mod
     
    14411445!
    14421446!-- Start processing data
    1443 
    1444        CALL location_message( 'starting allocation of chemistry emissions arrays', .FALSE. )
    1445 
    14461447!
    14471448!-- Emission LOD 0 (Parameterized mode)
  • palm/trunk/SOURCE/parin.f90

    r3885 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    696699             data_output_pr, data_output_2d_on_each_pe,                        &
    697700             debug_output,                                                     &
     701             debug_output_timestep,                                            &
    698702             disturbance_amplitude,                                            &
    699703             disturbance_energy_limit, disturbance_level_b,                    &
     
    720724             data_output_pr, data_output_2d_on_each_pe,                        &
    721725             debug_output,                                                     &
     726             debug_output_timestep,                                            &
    722727             disturbance_amplitude,                                            &
    723728             disturbance_energy_limit, disturbance_level_b,                    &
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3984 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3984 2019-05-16 15:17:03Z hellstea
    2730! Commenting improved, pmci_map_fine_to_coarse_grid renamed as pmci_map_child_grid_to_parent_grid,
    2831! set_child_edge_coords renamed as pmci_set_child_edge_coords, some variables renamed, etc.
     
    443446               constant_diffusion, constant_flux_layer,                        &
    444447               coupling_char,                                                  &
    445                debug_output, debug_string,                                     &
     448               debug_output_timestep,                                          &
    446449               dt_3d, dz, humidity, message_string,                            &
    447450               neutral, passive_scalar, rans_mode, rans_tke_e,                 &
     
    32193222   REAL(wp) ::  dtg       !<  Global time step defined as the global minimum of dtl of all processes
    32203223
    3221     IF ( debug_output )  THEN
    3222        WRITE( debug_string, * ) 'pmci_synchronize'
    3223        CALL debug_message( debug_string, 'start' )
    3224     ENDIF
     3224
     3225   IF ( debug_output_timestep )  CALL debug_message( 'pmci_synchronize', 'start' )
    32253226   
    32263227   dtl = dt_3d
     
    32283229   dt_3d  = dtg
    32293230
    3230     IF ( debug_output )  THEN
    3231        WRITE( debug_string, * ) 'pmci_synchronize'
    3232        CALL debug_message( debug_string, 'end' )
    3233     ENDIF
     3231   IF ( debug_output_timestep )  CALL debug_message( 'pmci_synchronize', 'end' )
    32343232
    32353233#endif
     
    32783276
    32793277#if defined( __parallel )   
    3280 !
    3281 !-- Debug location message
    3282     IF ( debug_output )  THEN
    3283        WRITE( debug_string, * ) 'pmci_datatrans'
    3284        CALL debug_message( debug_string, 'start' )
    3285     ENDIF
     3278
     3279    IF ( debug_output_timestep )  CALL debug_message( 'pmci_datatrans', 'start' )
    32863280
    32873281    IF ( TRIM( local_nesting_mode ) == 'one-way' )  THEN
     
    33193313
    33203314    ENDIF
    3321 !
    3322 !-- Debug location message
    3323     IF ( debug_output )  THEN
    3324        WRITE( debug_string, * ) 'pmci_datatrans'
    3325        CALL debug_message( debug_string, 'end' )
    3326     ENDIF
     3315
     3316    IF ( debug_output_timestep )  CALL debug_message( 'pmci_datatrans', 'end' )
    33273317
    33283318#endif
     
    47904780    INTEGER(iwp) ::  n   !< Running index for number of chemical species
    47914781   
    4792 !
    4793 !-- Debug location message
    4794     IF ( debug_output )  THEN
    4795        WRITE( debug_string, * ) 'pmci_boundary_conds'
    4796        CALL debug_message( debug_string, 'start' )
    4797     ENDIF
     4782
     4783    IF ( debug_output_timestep )  CALL debug_message( 'pmci_boundary_conds', 'start' )
    47984784!
    47994785!-- Set Dirichlet boundary conditions for horizontal velocity components
     
    49824968       ENDIF
    49834969    ENDIF   
    4984 !
    4985 !-- Debug location message
    4986     IF ( debug_output )  THEN
    4987        WRITE( debug_string, * ) 'pmci_boundary_conds'
    4988        CALL debug_message( debug_string, 'end' )
    4989     ENDIF
     4970
     4971    IF ( debug_output_timestep )  CALL debug_message( 'pmci_boundary_conds', 'end' )
    49904972
    49914973#endif
  • palm/trunk/SOURCE/prognostic_equations.f90

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

    r3943 r3987  
    2828! -----------------
    2929! $Id$
     30! Introduce alternative switch for debug output during timestepping
     31!
     32! 3943 2019-05-02 09:50:41Z maronga
    3033! Missing blank characteer added.
    3134!
     
    623626    USE control_parameters,                                                    &
    624627        ONLY:  cloud_droplets, coupling_char,                                  &
    625                debug_output, debug_string,                                     &
     628               debug_output, debug_output_timestep, debug_string,              &
    626629               dz, dt_spinup, end_time,                                        &
    627630               humidity,                                                       &
     
    13591362
    13601363
    1361        IF ( debug_output )  CALL debug_message( 'radiation_control', 'start' )
     1364       IF ( debug_output_timestep )  CALL debug_message( 'radiation_control', 'start' )
    13621365
    13631366
     
    13771380       END SELECT
    13781381
    1379        IF ( debug_output )  CALL debug_message( 'radiation_control', 'end' )
     1382       IF ( debug_output_timestep )  CALL debug_message( 'radiation_control', 'end' )
    13801383
    13811384    END SUBROUTINE radiation_control
     
    51115114
    51125115
    5113      IF ( debug_output )  CALL debug_message( 'radiation_interaction', 'start' )
     5116     IF ( debug_output_timestep )  CALL debug_message( 'radiation_interaction', 'start' )
    51145117
    51155118     IF ( plant_canopy )  THEN
     
    58575860           (emissivity_urb*sigma_sb * area_hor) )**0.25_wp
    58585861
    5859      IF ( debug_output )  CALL debug_message( 'radiation_interaction', 'end' )
     5862     IF ( debug_output_timestep )  CALL debug_message( 'radiation_interaction', 'end' )
    58605863
    58615864
  • palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

    r3885 r3987  
    2626! -----------------
    2727! $Id$
     28! Introduce alternative switch for debug output during timestepping
     29!
     30! 3885 2019-04-11 11:29:34Z kanani
    2831! Changes related to global restructuring of location messages and introduction
    2932! of additional debug messages
     
    278281               constant_heatflux, constant_scalarflux,                         &
    279282               constant_waterflux, coupling_mode,                              &
    280                debug_output, debug_string,                                     &
     283               debug_output_timestep,                                          &
    281284               do_output_at_2m, humidity,                                      &
    282285               ibc_e_b, ibc_pt_b, indoor_model, initializing_actions,          &
     
    364367
    365368
    366        IF ( debug_output )  CALL debug_message( 'surface_layer_fluxes', 'start' )
     369       IF ( debug_output_timestep )  CALL debug_message( 'surface_layer_fluxes', 'start' )
    367370
    368371       surf_vertical = .FALSE. !< flag indicating vertically orientated surface elements
     
    726729       mom_tke = .FALSE.
    727730
    728        IF ( debug_output )  CALL debug_message( 'surface_layer_fluxes', 'end' )
     731       IF ( debug_output_timestep )  CALL debug_message( 'surface_layer_fluxes', 'end' )
    729732
    730733    END SUBROUTINE surface_layer_fluxes
  • palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90

    r3938 r3987  
    2525! -----------------
    2626! $Id$
     27! Introduce alternative switch for debug output during timestepping
     28!
     29! 3938 2019-04-29 16:06:25Z suehring
    2730! Remove unused variables
    2831!
     
    209212
    210213    USE control_parameters,                                                    &
    211         ONLY:  debug_output,                                                   &
    212                debug_string,                                                   &
     214        ONLY:  debug_output_timestep,                                          &
    213215               initializing_actions,                                           &
    214216               message_string,                                                 &
     
    11461148    REAL(wp) :: volume_flow_l   !< local mass flux through lateral boundary
    11471149
    1148 !
    1149 !-- Debug location message
    1150     IF ( debug_output )  THEN
    1151        WRITE( debug_string, * ) 'stg_main'
    1152        CALL debug_message( debug_string, 'start' )
    1153     ENDIF
     1150
     1151    IF ( debug_output_timestep )  CALL debug_message( 'stg_main', 'start' )
    11541152!
    11551153!-- Calculate time step which is needed for filter functions
     
    14931491!-- Finally, set time counter for calling STG to zero
    14941492    time_stg_call = 0.0_wp
    1495 !
    1496 !-- Debug location message
    1497     IF ( debug_output )  THEN
    1498        WRITE( debug_string, * ) 'stg_main'
    1499        CALL debug_message( debug_string, 'end' )
    1500     ENDIF
     1493
     1494    IF ( debug_output_timestep )  CALL debug_message( 'stg_main', 'end' )
    15011495
    15021496 END SUBROUTINE stg_main
     
    19001894    IMPLICIT NONE
    19011895
    1902 !
    1903 !-- Debug location message
    1904     IF ( debug_output )  THEN
    1905        WRITE( debug_string, * ) 'stg_adjust'
    1906        CALL debug_message( debug_string, 'start' )
    1907     ENDIF
     1896
     1897    IF ( debug_output_timestep )  CALL debug_message( 'stg_adjust', 'start' )
    19081898!
    19091899!-- Compute mean boundary layer height according to Richardson-Bulk
     
    19381928!-- Reset time counter for controlling next adjustment to zero
    19391929    time_stg_adjust = 0.0_wp
    1940 !
    1941 !-- Debug location message
    1942     IF ( debug_output )  THEN
    1943        WRITE( debug_string, * ) 'stg_adjust'
    1944        CALL debug_message( debug_string, 'end' )
    1945     ENDIF
     1930
     1931    IF ( debug_output_timestep )  CALL debug_message( 'stg_adjust', 'end' )
    19461932   
    19471933 END SUBROUTINE stg_adjust
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3943 r3987  
    2828! -----------------
    2929! $Id$
     30! Introduce alternative switch for debug output during timestepping
     31!
     32! 3943 2019-05-02 09:50:41Z maronga
    3033! Removed qsws_eb. Bugfix in calculation of qsws.
    3134!
     
    489492    USE control_parameters,                                                    &
    490493        ONLY:  coupling_start_time, topography,                                &
    491                debug_output, debug_string,                                     &
     494               debug_output, debug_output_timestep, debug_string,              &
    492495               dt_3d, humidity, indoor_model,                                  &
    493496               intermediate_timestep_count, initializing_actions,              &
     
    52675270
    52685271
    5269         IF ( debug_output )  THEN
     5272        IF ( debug_output_timestep )  THEN
    52705273           WRITE( debug_string, * ) 'usm_material_heat_model | spinup: ', spinup
    52715274           CALL debug_message( debug_string, 'start' )
     
    56445647        !$OMP END PARALLEL
    56455648
    5646         IF ( debug_output )  THEN
     5649        IF ( debug_output_timestep )  THEN
    56475650           WRITE( debug_string, * ) 'usm_material_heat_model | spinup: ', spinup
    56485651           CALL debug_message( debug_string, 'end' )
     
    56825685
    56835686
    5684         IF ( debug_output )  CALL debug_message( 'usm_green_heat_model', 'start' )
     5687        IF ( debug_output_timestep )  CALL debug_message( 'usm_green_heat_model', 'start' )
    56855688
    56865689        drho_l_lv = 1.0_wp / (rho_l * l_v)
     
    60126015        ENDDO
    60136016
    6014         IF ( debug_output )  CALL debug_message( 'usm_green_heat_model', 'end' )
     6017        IF ( debug_output_timestep )  CALL debug_message( 'usm_green_heat_model', 'end' )
    60156018
    60166019    END SUBROUTINE usm_green_heat_model
     
    77077710
    77087711
    7709         IF ( debug_output )  THEN
     7712        IF ( debug_output_timestep )  THEN
    77107713           WRITE( debug_string, * ) 'usm_surface_energy_balance | spinup: ', spinup
    77117714           CALL debug_message( debug_string, 'start' )
     
    87538756!        END SUBROUTINE calc_q_surface_usm
    87548757
    8755         IF ( debug_output )  THEN
     8758        IF ( debug_output_timestep )  THEN
    87568759           WRITE( debug_string, * ) 'usm_surface_energy_balance | spinup: ', spinup
    87578760           CALL debug_message( debug_string, 'end' )
Note: See TracChangeset for help on using the changeset viewer.