Index: palm/trunk/SOURCE/radiation_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/radiation_model_mod.f90	(revision 3881)
+++ palm/trunk/SOURCE/radiation_model_mod.f90	(revision 3885)
@@ -15,7 +15,7 @@
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
-! Copyright 2015-2018 Institute of Computer Science of the 
+! Copyright 2015-2019 Institute of Computer Science of the 
 !                     Czech Academy of Sciences, Prague
-! Copyright 2015-2018 Czech Technical University in Prague
+! Copyright 2015-2019 Czech Technical University in Prague
 ! Copyright 1997-2019 Leibniz Universitaet Hannover
 !------------------------------------------------------------------------------!
@@ -28,4 +28,8 @@
 ! -----------------
 ! $Id$
+! Changes related to global restructuring of location messages and introduction 
+! of additional debug messages
+! 
+! 3881 2019-04-10 09:31:22Z suehring
 ! Output of albedo and emissivity moved from USM, bugfixes in initialization
 ! of albedo
@@ -612,5 +616,7 @@
 
     USE control_parameters,                                                    &
-        ONLY:  cloud_droplets, coupling_char, dz, dt_spinup, end_time,         &
+        ONLY:  cloud_droplets, coupling_char,                                  &
+               debug_output, debug_string,                                     &
+               dz, dt_spinup, end_time,                                        &
                humidity,                                                       &
                initializing_actions, io_blocks, io_group,                      &
@@ -1347,4 +1353,7 @@
 
 
+       IF ( debug_output )  CALL debug_message( 'radiation_control', 'start' )
+
+
        SELECT CASE ( TRIM( radiation_scheme ) )
 
@@ -1362,4 +1371,5 @@
        END SELECT
 
+       IF ( debug_output )  CALL debug_message( 'radiation_control', 'end' )
 
     END SUBROUTINE radiation_control
@@ -1835,4 +1845,6 @@
 #endif
 
+
+       IF ( debug_output )  CALL debug_message( 'radiation_init', 'start' )
 !
 !--    Activate radiation_interactions according to the existence of vertical surfaces and/or trees.
@@ -1858,9 +1870,4 @@
 !--    via sky-view factors. This must be done before radiation is initialized.
        IF ( radiation_interactions )  CALL radiation_interaction_init
-
-!
-!--    Initialize radiation model
-       CALL location_message( 'initializing radiation model', .FALSE. )
-
 !
 !--    Allocate array for storing the surface net radiation
@@ -2856,6 +2863,4 @@
        CALL init_date_and_time
 
-       CALL location_message( 'finished', .TRUE. )
-
 !
 !--    Find all discretized apparent solar positions for radiation interaction.
@@ -2867,14 +2872,10 @@
 !
 !--       Read sky-view factors and further required data from file
-          CALL location_message( '    Start reading SVF from file', .FALSE. )
           CALL radiation_read_svf()
-          CALL location_message( '    Reading SVF from file has finished', .TRUE. )
 
        ELSEIF ( radiation_interactions .AND. .NOT. read_svf)  THEN
 !
 !--       calculate SFV and CSF
-          CALL location_message( '    Start calculation of SVF', .FALSE. )
           CALL radiation_calc_svf()
-          CALL location_message( '    Calculation of SVF has finished', .TRUE. )
        ENDIF
 
@@ -2882,7 +2883,5 @@
 !
 !--       Write svf, csf svfsurf and csfsurf data to file
-          CALL location_message( '    Start writing SVF in file', .FALSE. )
           CALL radiation_write_svf()
-          CALL location_message( '    Writing SVF in file has finished', .TRUE. )
        ENDIF
 
@@ -2894,5 +2893,7 @@
        ENDIF
 
-       RETURN
+       IF ( debug_output )  CALL debug_message( 'radiation_init', 'end' )
+
+       RETURN !todo: remove, I don't see what we need this for here
 
     END SUBROUTINE radiation_init
@@ -5104,4 +5105,6 @@
 
 
+     IF ( debug_output )  CALL debug_message( 'radiation_interaction', 'start' )
+
      IF ( plant_canopy )  THEN
          pchf_prep(:) = r_d * exner(nz_urban_b:nz_urban_t)                                 &
@@ -5848,4 +5851,7 @@
            (emissivity_urb*sigma_sb * area_hor) )**0.25_wp
 
+     IF ( debug_output )  CALL debug_message( 'radiation_interaction', 'end' )
+
+
     CONTAINS
 
@@ -5978,5 +5984,4 @@
     END SUBROUTINE calc_diffusion_radiation
 
-
  END SUBROUTINE radiation_interaction
     
@@ -6143,5 +6148,6 @@
 !--    allocate urban surfaces grid
 !--    calc number of surfaces in local proc
-       CALL location_message( '    calculation of indices for surfaces', .TRUE. )
+       IF ( debug_output )  CALL debug_message( 'calculation of indices for surfaces', 'info' )
+
        nsurfl = 0
 !
@@ -6478,5 +6484,5 @@
 !--
 !--    allocation of the arrays for direct and diffusion radiation
-       CALL location_message( '    allocation of radiation arrays', .TRUE. )
+       IF ( debug_output )  CALL debug_message( 'allocation of radiation arrays', 'info' )
 !--    rad_sw_in, rad_lw_in are computed in radiation model,
 !--    splitting of direct and diffusion part is done
@@ -6577,9 +6583,8 @@
 !    
         INTEGER(iwp), DIMENSION(0:svfnorm_report_num) :: svfnorm_counts
-        CHARACTER(200)                                :: msg
+
 
 !--     calculation of the SVF
-        CALL location_message( '    calculation of SVF and CSF', .TRUE. )
-        CALL radiation_write_debug_log('Start calculation of SVF and CSF')
+        CALL location_message( 'calculating view factors for radiation interaction', 'start' )
 
 !--     initialize variables and temporary arrays for calculation of svf and csf
@@ -6921,6 +6926,8 @@
                      ENDIF
 
-                     WRITE (msg,'(A,3I12)') 'Grow asvf:',nsvfl,nsvfla,k
-                     CALL radiation_write_debug_log( msg )
+                     IF ( debug_output )  THEN
+                        WRITE( debug_string, '(A,3I12)' ) 'Grow asvf:', nsvfl, nsvfla, k
+                        CALL debug_message( debug_string, 'info' )
+                     ENDIF
                      
                      nsvfla = k
@@ -7004,6 +7011,8 @@
                      ENDIF
 
-                     WRITE(msg,'(A,3I12)') 'Grow asvf:',nsvfl,nsvfla,k
-                     CALL radiation_write_debug_log( msg )
+                     IF ( debug_output )  THEN
+                        WRITE( debug_string, '(A,3I12)' ) 'Grow asvf:', nsvfl, nsvfla, k
+                        CALL debug_message( debug_string, 'info' )
+                     ENDIF
                      
                      nsvfla = k
@@ -7172,6 +7181,8 @@
                     ENDIF
 
-                    WRITE (msg,'(A,3I12)') 'Grow amrtf:', nmrtf, nmrtfa, k
-                    CALL radiation_write_debug_log( msg )
+                    IF ( debug_output )  THEN
+                       WRITE( debug_string, '(A,3I12)' ) 'Grow amrtf:', nmrtf, nmrtfa, k
+                       CALL debug_message( debug_string, 'info' )
+                    ENDIF
 
                     nmrtfa = k
@@ -7224,13 +7235,6 @@
         ENDIF
 
-        CALL radiation_write_debug_log( 'End of calculation SVF' )
-        WRITE(msg, *) 'Raytracing skipped for maximum distance of ', &
-           max_raytracing_dist, ' m on ', ray_skip_maxdist, ' pairs.'
-        CALL radiation_write_debug_log( msg )
-        WRITE(msg, *) 'Raytracing skipped for minimum potential value of ', &
-           min_irrf_value , ' on ', ray_skip_minval, ' pairs.'
-        CALL radiation_write_debug_log( msg )
-
-        CALL location_message( '    waiting for completion of SVF and CSF calculation in all processes', .TRUE. )
+        IF ( debug_output )  CALL debug_message( 'waiting for completion of SVF and CSF calculation in all processes', 'info' )
+
 !--     deallocate temporary global arrays
         DEALLOCATE(nzterr)
@@ -7274,8 +7278,8 @@
         ENDIF
 
-        CALL location_message( '    calculation of the complete SVF array', .TRUE. )
+        IF ( debug_output )  CALL debug_message( 'calculation of the complete SVF array', 'info' )
 
         IF ( rad_angular_discretization )  THEN
-           CALL radiation_write_debug_log( 'Load svf from the structure array to plain arrays' )
+           IF ( debug_output )  CALL debug_message( 'Load svf from the structure array to plain arrays', 'info' )
            ALLOCATE( svf(ndsvf,nsvfl) )
            ALLOCATE( svfsurf(idsvf,nsvfl) )
@@ -7286,10 +7290,10 @@
            ENDDO
         ELSE
-           CALL radiation_write_debug_log( 'Start SVF sort' )
+           IF ( debug_output )  CALL debug_message( 'Start SVF sort', 'info' )
 !--        sort svf ( a version of quicksort )
            CALL quicksort_svf(asvf,1,nsvfl)
 
            !< load svf from the structure array to plain arrays
-           CALL radiation_write_debug_log( 'Load svf from the structure array to plain arrays' )
+           IF ( debug_output )  CALL debug_message( 'Load svf from the structure array to plain arrays', 'info' )
            ALLOCATE( svf(ndsvf,nsvfl) )
            ALLOCATE( svfsurf(idsvf,nsvfl) )
@@ -7346,6 +7350,5 @@
         IF ( plant_canopy )  THEN
 
-            CALL location_message( '    calculation of the complete CSF array', .TRUE. )
-            CALL radiation_write_debug_log( 'Calculation of the complete CSF array' )
+            IF ( debug_output )  CALL debug_message( 'Calculation of the complete CSF array', 'info' )
 !--         sort and merge csf for the last time, keeping the array size to minimum
             CALL merge_and_grow_csf(-1)
@@ -7419,6 +7422,8 @@
 !--         scatter and gather the number of elements to and from all processor
 !--         and calculate displacements
-            CALL radiation_write_debug_log( 'Scatter and gather the number of elements to and from all processor' )
+            IF ( debug_output )  CALL debug_message( 'Scatter and gather the number of elements to and from all processor', 'info' )
+
             CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr)
+
             IF ( ierr /= 0 ) THEN
                 WRITE(9,*) 'Error MPI_AlltoAll1:', ierr, SIZE(icsflt), SIZE(ipcsflt)
@@ -7434,5 +7439,5 @@
 
 !--         exchange csf fields between processors
-            CALL radiation_write_debug_log( 'Exchange csf fields between processors' )
+            IF ( debug_output )  CALL debug_message( 'Exchange csf fields between processors', 'info' )
             udim = max(npcsfl,1)
             ALLOCATE( pcsflt_l(ndcsf*udim) )
@@ -7473,10 +7478,10 @@
 
 !--         sort csf ( a version of quicksort )
-            CALL radiation_write_debug_log( 'Sort csf' )
+            IF ( debug_output )  CALL debug_message( 'Sort csf', 'info' )
             CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl)
 
 !--         aggregate canopy sink factor records with identical box & source
 !--         againg across all values from all processors
-            CALL radiation_write_debug_log( 'Aggregate canopy sink factor records with identical box' )
+            IF ( debug_output )  CALL debug_message( 'Aggregate canopy sink factor records with identical box', 'info' )
 
             IF ( npcsfl > 0 )  THEN
@@ -7521,5 +7526,5 @@
             DEALLOCATE( pcsflt_l )
             DEALLOCATE( kpcsflt_l )
-            CALL radiation_write_debug_log( 'End of aggregate csf' )
+            IF ( debug_output )  CALL debug_message( 'End of aggregate csf', 'info' )
             
         ENDIF
@@ -7528,7 +7533,7 @@
         CALL MPI_BARRIER( comm2d, ierr )
 #endif
-        CALL radiation_write_debug_log( 'End of radiation_calc_svf (after mpi_barrier)' )
-
-        RETURN
+        CALL location_message( 'calculating view factors for radiation interaction', 'finished' )
+
+        RETURN  !todo: remove
         
 !        WRITE( message_string, * )  &
@@ -8440,5 +8445,8 @@
        INTEGER(iwp)                 :: nsurfl_from_file = 0
        INTEGER(iwp)                 :: nmrtbl_from_file = 0
-       
+
+
+       CALL location_message( 'reading view factors for radiation interaction', 'start' )
+
        DO  i = 0, io_blocks-1
           IF ( i == io_group )  THEN
@@ -8484,8 +8492,8 @@
                  CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 )
              ELSE
-                 WRITE(message_string,*) '    Number of SVF, CSF, and nsurfl ',&
+                 WRITE(debug_string,*)   'Number of SVF, CSF, and nsurfl ',    &
                                          'to read', nsvfl, ncsfl,              &
                                          nsurfl_from_file
-                 CALL location_message( message_string, .TRUE. )
+                 IF ( debug_output )  CALL debug_message( debug_string, 'info' )
              ENDIF
              
@@ -8516,6 +8524,6 @@
                  CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
              ELSE
-                 WRITE(message_string,*) '    Number of nmrtf to read ', nmrtf
-                 CALL location_message( message_string, .TRUE. )
+                 WRITE(debug_string,*) 'Number of nmrtf to read ', nmrtf
+                 IF ( debug_output )  CALL debug_message( debug_string, 'info' )
              ENDIF
               
@@ -8578,4 +8586,7 @@
        ENDDO
 
+       CALL location_message( 'reading view factors for radiation interaction', 'finished' )
+
+
     END SUBROUTINE radiation_read_svf
 
@@ -8592,4 +8603,7 @@
        
        INTEGER(iwp)        :: i
+
+
+       CALL location_message( 'writing view factors for radiation interaction', 'start' )
 
        DO  i = 0, io_blocks-1
@@ -8636,4 +8650,8 @@
 #endif
        ENDDO
+
+       CALL location_message( 'writing view factors for radiation interaction', 'finished' )
+
+
     END SUBROUTINE radiation_write_svf
 
@@ -8788,5 +8806,5 @@
         INTEGER(iwp)                            :: iread, iwrite
         TYPE(t_csf), DIMENSION(:), POINTER      :: acsfnew
-        CHARACTER(100)                          :: msg
+
 
         IF ( newsize == -1 )  THEN
@@ -8852,6 +8870,8 @@
         ncsfla = newsize
 
-        WRITE(msg,'(A,2I12)') 'Grow acsf2:',ncsfl,ncsfla
-        CALL radiation_write_debug_log( msg )
+        IF ( debug_output )  THEN
+           WRITE( debug_string, '(A,2I12)' ) 'Grow acsf2:', ncsfl, ncsfla
+           CALL debug_message( debug_string, 'info' )
+        ENDIF
 
     END SUBROUTINE merge_and_grow_csf
@@ -11490,21 +11510,4 @@
  END SUBROUTINE radiation_rrd_local
 
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine writes debug information
-!------------------------------------------------------------------------------!
- SUBROUTINE radiation_write_debug_log ( message )
-    !> it writes debug log with time stamp
-    CHARACTER(*)  :: message
-    CHARACTER(15) :: dtc
-    CHARACTER(8)  :: date
-    CHARACTER(10) :: time
-    CHARACTER(5)  :: zone
-    CALL date_and_time(date, time, zone)
-    dtc = date(7:8)//','//time(1:2)//':'//time(3:4)//':'//time(5:10)
-    WRITE(9,'(2A)') dtc, TRIM(message)
-    FLUSH(9)
- END SUBROUTINE radiation_write_debug_log
 
  END MODULE radiation_model_mod
