Changeset 3885 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Apr 11, 2019 11:29:34 AM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3881 r3885 15 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 ! 17 ! Copyright 2015-201 8Institute of Computer Science of the17 ! Copyright 2015-2019 Institute of Computer Science of the 18 18 ! Czech Academy of Sciences, Prague 19 ! Copyright 2015-201 8Czech Technical University in Prague19 ! Copyright 2015-2019 Czech Technical University in Prague 20 20 ! Copyright 1997-2019 Leibniz Universitaet Hannover 21 21 !------------------------------------------------------------------------------! … … 28 28 ! ----------------- 29 29 ! $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 30 34 ! Output of albedo and emissivity moved from USM, bugfixes in initialization 31 35 ! of albedo … … 612 616 613 617 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, & 615 621 humidity, & 616 622 initializing_actions, io_blocks, io_group, & … … 1347 1353 1348 1354 1355 IF ( debug_output ) CALL debug_message( 'radiation_control', 'start' ) 1356 1357 1349 1358 SELECT CASE ( TRIM( radiation_scheme ) ) 1350 1359 … … 1362 1371 END SELECT 1363 1372 1373 IF ( debug_output ) CALL debug_message( 'radiation_control', 'end' ) 1364 1374 1365 1375 END SUBROUTINE radiation_control … … 1835 1845 #endif 1836 1846 1847 1848 IF ( debug_output ) CALL debug_message( 'radiation_init', 'start' ) 1837 1849 ! 1838 1850 !-- Activate radiation_interactions according to the existence of vertical surfaces and/or trees. … … 1858 1870 !-- via sky-view factors. This must be done before radiation is initialized. 1859 1871 IF ( radiation_interactions ) CALL radiation_interaction_init 1860 1861 !1862 !-- Initialize radiation model1863 CALL location_message( 'initializing radiation model', .FALSE. )1864 1865 1872 ! 1866 1873 !-- Allocate array for storing the surface net radiation … … 2856 2863 CALL init_date_and_time 2857 2864 2858 CALL location_message( 'finished', .TRUE. )2859 2860 2865 ! 2861 2866 !-- Find all discretized apparent solar positions for radiation interaction. … … 2867 2872 ! 2868 2873 !-- Read sky-view factors and further required data from file 2869 CALL location_message( ' Start reading SVF from file', .FALSE. )2870 2874 CALL radiation_read_svf() 2871 CALL location_message( ' Reading SVF from file has finished', .TRUE. )2872 2875 2873 2876 ELSEIF ( radiation_interactions .AND. .NOT. read_svf) THEN 2874 2877 ! 2875 2878 !-- calculate SFV and CSF 2876 CALL location_message( ' Start calculation of SVF', .FALSE. )2877 2879 CALL radiation_calc_svf() 2878 CALL location_message( ' Calculation of SVF has finished', .TRUE. )2879 2880 ENDIF 2880 2881 … … 2882 2883 ! 2883 2884 !-- Write svf, csf svfsurf and csfsurf data to file 2884 CALL location_message( ' Start writing SVF in file', .FALSE. )2885 2885 CALL radiation_write_svf() 2886 CALL location_message( ' Writing SVF in file has finished', .TRUE. )2887 2886 ENDIF 2888 2887 … … 2894 2893 ENDIF 2895 2894 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 2897 2898 2898 2899 END SUBROUTINE radiation_init … … 5104 5105 5105 5106 5107 IF ( debug_output ) CALL debug_message( 'radiation_interaction', 'start' ) 5108 5106 5109 IF ( plant_canopy ) THEN 5107 5110 pchf_prep(:) = r_d * exner(nz_urban_b:nz_urban_t) & … … 5848 5851 (emissivity_urb*sigma_sb * area_hor) )**0.25_wp 5849 5852 5853 IF ( debug_output ) CALL debug_message( 'radiation_interaction', 'end' ) 5854 5855 5850 5856 CONTAINS 5851 5857 … … 5978 5984 END SUBROUTINE calc_diffusion_radiation 5979 5985 5980 5981 5986 END SUBROUTINE radiation_interaction 5982 5987 … … 6143 6148 !-- allocate urban surfaces grid 6144 6149 !-- 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 6146 6152 nsurfl = 0 6147 6153 ! … … 6478 6484 !-- 6479 6485 !-- 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' ) 6481 6487 !-- rad_sw_in, rad_lw_in are computed in radiation model, 6482 6488 !-- splitting of direct and diffusion part is done … … 6577 6583 ! 6578 6584 INTEGER(iwp), DIMENSION(0:svfnorm_report_num) :: svfnorm_counts 6579 CHARACTER(200) :: msg 6585 6580 6586 6581 6587 !-- 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' ) 6584 6589 6585 6590 !-- initialize variables and temporary arrays for calculation of svf and csf … … 6921 6926 ENDIF 6922 6927 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 6925 6932 6926 6933 nsvfla = k … … 7004 7011 ENDIF 7005 7012 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 7008 7017 7009 7018 nsvfla = k … … 7172 7181 ENDIF 7173 7182 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 7176 7187 7177 7188 nmrtfa = k … … 7224 7235 ENDIF 7225 7236 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 7235 7239 !-- deallocate temporary global arrays 7236 7240 DEALLOCATE(nzterr) … … 7274 7278 ENDIF 7275 7279 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' ) 7277 7281 7278 7282 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' ) 7280 7284 ALLOCATE( svf(ndsvf,nsvfl) ) 7281 7285 ALLOCATE( svfsurf(idsvf,nsvfl) ) … … 7286 7290 ENDDO 7287 7291 ELSE 7288 CALL radiation_write_debug_log( 'Start SVF sort' )7292 IF ( debug_output ) CALL debug_message( 'Start SVF sort', 'info' ) 7289 7293 !-- sort svf ( a version of quicksort ) 7290 7294 CALL quicksort_svf(asvf,1,nsvfl) 7291 7295 7292 7296 !< 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' ) 7294 7298 ALLOCATE( svf(ndsvf,nsvfl) ) 7295 7299 ALLOCATE( svfsurf(idsvf,nsvfl) ) … … 7346 7350 IF ( plant_canopy ) THEN 7347 7351 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' ) 7350 7353 !-- sort and merge csf for the last time, keeping the array size to minimum 7351 7354 CALL merge_and_grow_csf(-1) … … 7419 7422 !-- scatter and gather the number of elements to and from all processor 7420 7423 !-- 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 7422 7426 CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr) 7427 7423 7428 IF ( ierr /= 0 ) THEN 7424 7429 WRITE(9,*) 'Error MPI_AlltoAll1:', ierr, SIZE(icsflt), SIZE(ipcsflt) … … 7434 7439 7435 7440 !-- 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' ) 7437 7442 udim = max(npcsfl,1) 7438 7443 ALLOCATE( pcsflt_l(ndcsf*udim) ) … … 7473 7478 7474 7479 !-- sort csf ( a version of quicksort ) 7475 CALL radiation_write_debug_log( 'Sort csf' )7480 IF ( debug_output ) CALL debug_message( 'Sort csf', 'info' ) 7476 7481 CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl) 7477 7482 7478 7483 !-- aggregate canopy sink factor records with identical box & source 7479 7484 !-- 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' ) 7481 7486 7482 7487 IF ( npcsfl > 0 ) THEN … … 7521 7526 DEALLOCATE( pcsflt_l ) 7522 7527 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' ) 7524 7529 7525 7530 ENDIF … … 7528 7533 CALL MPI_BARRIER( comm2d, ierr ) 7529 7534 #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 7533 7538 7534 7539 ! WRITE( message_string, * ) & … … 8440 8445 INTEGER(iwp) :: nsurfl_from_file = 0 8441 8446 INTEGER(iwp) :: nmrtbl_from_file = 0 8442 8447 8448 8449 CALL location_message( 'reading view factors for radiation interaction', 'start' ) 8450 8443 8451 DO i = 0, io_blocks-1 8444 8452 IF ( i == io_group ) THEN … … 8484 8492 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 8485 8493 ELSE 8486 WRITE( message_string,*) ' Number of SVF, CSF, and nsurfl ',&8494 WRITE(debug_string,*) 'Number of SVF, CSF, and nsurfl ', & 8487 8495 'to read', nsvfl, ncsfl, & 8488 8496 nsurfl_from_file 8489 CALL location_message( message_string, .TRUE.)8497 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 8490 8498 ENDIF 8491 8499 … … 8516 8524 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 8517 8525 ELSE 8518 WRITE( message_string,*) 'Number of nmrtf to read ', nmrtf8519 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' ) 8520 8528 ENDIF 8521 8529 … … 8578 8586 ENDDO 8579 8587 8588 CALL location_message( 'reading view factors for radiation interaction', 'finished' ) 8589 8590 8580 8591 END SUBROUTINE radiation_read_svf 8581 8592 … … 8592 8603 8593 8604 INTEGER(iwp) :: i 8605 8606 8607 CALL location_message( 'writing view factors for radiation interaction', 'start' ) 8594 8608 8595 8609 DO i = 0, io_blocks-1 … … 8636 8650 #endif 8637 8651 ENDDO 8652 8653 CALL location_message( 'writing view factors for radiation interaction', 'finished' ) 8654 8655 8638 8656 END SUBROUTINE radiation_write_svf 8639 8657 … … 8788 8806 INTEGER(iwp) :: iread, iwrite 8789 8807 TYPE(t_csf), DIMENSION(:), POINTER :: acsfnew 8790 CHARACTER(100) :: msg 8808 8791 8809 8792 8810 IF ( newsize == -1 ) THEN … … 8852 8870 ncsfla = newsize 8853 8871 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 8856 8876 8857 8877 END SUBROUTINE merge_and_grow_csf … … 11490 11510 END SUBROUTINE radiation_rrd_local 11491 11511 11492 !------------------------------------------------------------------------------!11493 ! Description:11494 ! ------------11495 !> Subroutine writes debug information11496 !------------------------------------------------------------------------------!11497 SUBROUTINE radiation_write_debug_log ( message )11498 !> it writes debug log with time stamp11499 CHARACTER(*) :: message11500 CHARACTER(15) :: dtc11501 CHARACTER(8) :: date11502 CHARACTER(10) :: time11503 CHARACTER(5) :: zone11504 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_log11509 11512 11510 11513 END MODULE radiation_model_mod
Note: See TracChangeset
for help on using the changeset viewer.
