Changeset 4187 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Aug 26, 2019 12:43:15 PM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r4182 r4187 28 28 ! ----------------- 29 29 ! $Id$ 30 ! - Take external radiation from root domain dynamic input if not provided for 31 ! each nested domain 32 ! - Combine MPI_ALLREDUCE calls to reduce mpi overhead 33 ! 34 ! 4182 2019-08-22 15:20:23Z scharf 30 35 ! Corrected "Former revisions" section 31 36 ! … … 234 239 inquire_variable_names, & 235 240 input_file_dynamic, & 241 input_pids_dynamic, & 236 242 netcdf_data_input_get_dimension_length, & 237 243 num_var_pids, & … … 1453 1459 INTEGER(iwp) :: ind_type !< running index for subgrid-surface tiles 1454 1460 #endif 1461 LOGICAL :: radiation_input_root_domain !< flag indicating the existence of a dynamic input file for the root domain 1455 1462 1456 1463 … … 2451 2458 IF ( radiation_scheme == 'external' ) THEN 2452 2459 ! 2453 !-- Open the radiation input file 2460 !-- Open the radiation input file. Note, for child domain, a dynamic 2461 !-- input file is often not provided. In order to do not need to 2462 !-- duplicate the dynamic input file just for the radiation input, take 2463 !-- it from the dynamic file for the parent if not available for the 2464 !-- child domain(s). In this case this is possible because radiation 2465 !-- input should be the same for each model. 2466 INQUIRE( FILE = TRIM( input_file_dynamic ), & 2467 EXIST = radiation_input_root_domain ) 2468 2469 IF ( .NOT. input_pids_dynamic .AND. & 2470 .NOT. radiation_input_root_domain ) THEN 2471 message_string = 'In case of external radiation forcing ' // & 2472 'a dynamic input file is required. If no ' // & 2473 'dynamic input for the child domain(s) is ' // & 2474 'provided, at least one for the root domain ' // & 2475 'needs to be provided.' 2476 CALL message( 'radiation_init', 'PA0315', 1, 2, 0, 6, 0 ) 2477 ENDIF 2454 2478 #if defined( __netcdf ) 2455 CALL open_read_file( TRIM( input_file_dynamic ) // & 2456 TRIM( coupling_char ), & 2457 pids_id ) 2479 ! 2480 !-- Open dynamic input file for child domain if available, else, open 2481 !-- dynamic input file for the root domain. 2482 IF ( input_pids_dynamic ) THEN 2483 CALL open_read_file( TRIM( input_file_dynamic ) // & 2484 TRIM( coupling_char ), & 2485 pids_id ) 2486 ELSEIF ( radiation_input_root_domain ) THEN 2487 CALL open_read_file( TRIM( input_file_dynamic ), & 2488 pids_id ) 2489 ENDIF 2458 2490 2459 2491 CALL inquire_num_variables( pids_id, num_var_pids ) … … 2462 2494 ALLOCATE( vars_pids(1:num_var_pids) ) 2463 2495 CALL inquire_variable_names( pids_id, vars_pids ) 2464 2465 2496 ! 2466 2497 !-- Input time dimension. … … 2519 2550 ENDIF 2520 2551 ! 2521 !-- Finally, close the input file. 2552 !-- Finally, close the input file and deallocate temporary arrays 2553 DEALLOCATE( vars_pids ) 2554 2522 2555 CALL close_input_file( pids_id ) 2523 2556 #endif … … 5113 5146 IMPLICIT NONE 5114 5147 5115 INTEGER(iwp) :: i, j, k, kk, d, refstep, m, mm, l, ll5116 INTEGER(iwp) :: isurf, isurfsrc, isvf, icsf, ipcgb5117 INTEGER(iwp) :: imrt, imrtf5118 INTEGER(iwp) :: isd !< solar direction number5119 INTEGER(iwp) :: pc_box_dimshift !< transform for best accuracy5120 INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /)5121 5122 REAL(wp), DIMENSION(3,3) :: mrot !< grid rotation matrix (zyx)5123 REAL(wp), DIMENSION(3,0:nsurf_type):: vnorm !< face direction normal vectors (zyx)5124 REAL(wp), DIMENSION(3) :: sunorig !< grid rotated solar direction unit vector (zyx)5125 REAL(wp), DIMENSION(3) :: sunorig_grid !< grid squashed solar direction unit vector (zyx)5126 REAL(wp), DIMENSION(0:nsurf_type) :: costheta !< direct irradiance factor of solar angle5127 REAL(wp), DIMENSION(nz_urban_b:nz_urban_t) ::pchf_prep !< precalculated factor for canopy temperature tendency5148 INTEGER(iwp) :: i, j, k, kk, d, refstep, m, mm, l, ll 5149 INTEGER(iwp) :: isurf, isurfsrc, isvf, icsf, ipcgb 5150 INTEGER(iwp) :: imrt, imrtf 5151 INTEGER(iwp) :: isd !< solar direction number 5152 INTEGER(iwp) :: pc_box_dimshift !< transform for best accuracy 5153 INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /) 5154 5155 REAL(wp), DIMENSION(3,3) :: mrot !< grid rotation matrix (zyx) 5156 REAL(wp), DIMENSION(3,0:nsurf_type):: vnorm !< face direction normal vectors (zyx) 5157 REAL(wp), DIMENSION(3) :: sunorig !< grid rotated solar direction unit vector (zyx) 5158 REAL(wp), DIMENSION(3) :: sunorig_grid !< grid squashed solar direction unit vector (zyx) 5159 REAL(wp), DIMENSION(0:nsurf_type) :: costheta !< direct irradiance factor of solar angle 5160 REAL(wp), DIMENSION(nz_urban_b:nz_urban_t) :: pchf_prep !< precalculated factor for canopy temperature tendency 5128 5161 REAL(wp), PARAMETER :: alpha = 0._wp !< grid rotation (TODO: synchronize with rotation_angle 5129 5162 !< from netcdf_data_input_mod) 5130 REAL(wp) :: pc_box_area, pc_abs_frac, pc_abs_eff 5131 REAL(wp) :: asrc !< area of source face 5132 REAL(wp) :: pcrad !< irradiance from plant canopy 5133 REAL(wp) :: pabsswl = 0.0_wp !< total absorbed SW radiation energy in local processor (W) 5134 REAL(wp) :: pabssw = 0.0_wp !< total absorbed SW radiation energy in all processors (W) 5135 REAL(wp) :: pabslwl = 0.0_wp !< total absorbed LW radiation energy in local processor (W) 5136 REAL(wp) :: pabslw = 0.0_wp !< total absorbed LW radiation energy in all processors (W) 5137 REAL(wp) :: pemitlwl = 0.0_wp !< total emitted LW radiation energy in all processors (W) 5138 REAL(wp) :: pemitlw = 0.0_wp !< total emitted LW radiation energy in all processors (W) 5139 REAL(wp) :: pinswl = 0.0_wp !< total received SW radiation energy in local processor (W) 5140 REAL(wp) :: pinsw = 0.0_wp !< total received SW radiation energy in all processor (W) 5141 REAL(wp) :: pinlwl = 0.0_wp !< total received LW radiation energy in local processor (W) 5142 REAL(wp) :: pinlw = 0.0_wp !< total received LW radiation energy in all processor (W) 5143 REAL(wp) :: emiss_sum_surfl !< sum of emissisivity of surfaces in local processor 5144 REAL(wp) :: emiss_sum_surf !< sum of emissisivity of surfaces in all processor 5145 REAL(wp) :: area_surfl !< total area of surfaces in local processor 5146 REAL(wp) :: area_surf !< total area of surfaces in all processor 5147 REAL(wp) :: area_hor !< total horizontal area of domain in all processor 5148 5163 REAL(wp) :: pc_box_area, pc_abs_frac, pc_abs_eff 5164 REAL(wp) :: asrc !< area of source face 5165 REAL(wp) :: pcrad !< irradiance from plant canopy 5166 REAL(wp) :: pabsswl = 0.0_wp !< total absorbed SW radiation energy in local processor (W) 5167 REAL(wp) :: pabssw = 0.0_wp !< total absorbed SW radiation energy in all processors (W) 5168 REAL(wp) :: pabslwl = 0.0_wp !< total absorbed LW radiation energy in local processor (W) 5169 REAL(wp) :: pabslw = 0.0_wp !< total absorbed LW radiation energy in all processors (W) 5170 REAL(wp) :: pemitlwl = 0.0_wp !< total emitted LW radiation energy in all processors (W) 5171 REAL(wp) :: pemitlw = 0.0_wp !< total emitted LW radiation energy in all processors (W) 5172 REAL(wp) :: pinswl = 0.0_wp !< total received SW radiation energy in local processor (W) 5173 REAL(wp) :: pinsw = 0.0_wp !< total received SW radiation energy in all processor (W) 5174 REAL(wp) :: pinlwl = 0.0_wp !< total received LW radiation energy in local processor (W) 5175 REAL(wp) :: pinlw = 0.0_wp !< total received LW radiation energy in all processor (W) 5176 REAL(wp) :: emiss_sum_surfl !< sum of emissisivity of surfaces in local processor 5177 REAL(wp) :: emiss_sum_surf !< sum of emissisivity of surfaces in all processor 5178 REAL(wp) :: area_surfl !< total area of surfaces in local processor 5179 REAL(wp) :: area_surf !< total area of surfaces in all processor 5180 REAL(wp) :: area_hor !< total horizontal area of domain in all processor 5181 #if defined( __parallel ) 5182 REAL(wp), DIMENSION(1:7) :: combine_allreduce !< dummy array used to combine several MPI_ALLREDUCE calls 5183 REAL(wp), DIMENSION(1:7) :: combine_allreduce_l !< dummy array used to combine several MPI_ALLREDUCE calls 5184 #endif 5149 5185 5150 5186 IF ( debug_output_timestep ) CALL debug_message( 'radiation_interaction', 'start' ) … … 5829 5865 pabsswl = pabsswl + SUM(pcbinsw) 5830 5866 pabslwl = pabslwl + SUM(pcbinlw) 5831 pinswl = pinswl + SUM(pcbinswdir) + SUM(pcbinswdif)5867 pinswl = pinswl + SUM(pcbinswdir) + SUM(pcbinswdif) 5832 5868 ENDIF 5833 5869 ! 5834 !-- gather all rad flux energy in all processors 5870 !-- gather all rad flux energy in all processors. In order to reduce 5871 !-- the number of MPI calls (to reduce latencies), combine the required 5872 !-- quantities in one array, sum it up, and subsequently re-distribute 5873 !-- back to the respective quantities. 5835 5874 #if defined( __parallel ) 5836 CALL MPI_ALLREDUCE( pinswl, pinsw, 1, MPI_REAL, MPI_SUM, comm2d, ierr) 5837 IF ( ierr /= 0 ) THEN 5838 WRITE(9,*) 'Error MPI_AllReduce5:', ierr, pinswl, pinsw 5839 FLUSH(9) 5840 ENDIF 5841 CALL MPI_ALLREDUCE( pinlwl, pinlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr) 5842 IF ( ierr /= 0 ) THEN 5843 WRITE(9,*) 'Error MPI_AllReduce6:', ierr, pinlwl, pinlw 5844 FLUSH(9) 5845 ENDIF 5846 CALL MPI_ALLREDUCE( pabsswl, pabssw, 1, MPI_REAL, MPI_SUM, comm2d, ierr ) 5847 IF ( ierr /= 0 ) THEN 5848 WRITE(9,*) 'Error MPI_AllReduce7:', ierr, pabsswl, pabssw 5849 FLUSH(9) 5850 ENDIF 5851 CALL MPI_ALLREDUCE( pabslwl, pabslw, 1, MPI_REAL, MPI_SUM, comm2d, ierr ) 5852 IF ( ierr /= 0 ) THEN 5853 WRITE(9,*) 'Error MPI_AllReduce8:', ierr, pabslwl, pabslw 5854 FLUSH(9) 5855 ENDIF 5856 CALL MPI_ALLREDUCE( pemitlwl, pemitlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr ) 5857 IF ( ierr /= 0 ) THEN 5858 WRITE(9,*) 'Error MPI_AllReduce8:', ierr, pemitlwl, pemitlw 5859 FLUSH(9) 5860 ENDIF 5861 CALL MPI_ALLREDUCE( emiss_sum_surfl, emiss_sum_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr ) 5862 IF ( ierr /= 0 ) THEN 5863 WRITE(9,*) 'Error MPI_AllReduce9:', ierr, emiss_sum_surfl, emiss_sum_surf 5864 FLUSH(9) 5865 ENDIF 5866 CALL MPI_ALLREDUCE( area_surfl, area_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr ) 5867 IF ( ierr /= 0 ) THEN 5868 WRITE(9,*) 'Error MPI_AllReduce10:', ierr, area_surfl, area_surf 5869 FLUSH(9) 5870 ENDIF 5875 combine_allreduce_l(1) = pinswl 5876 combine_allreduce_l(2) = pinlwl 5877 combine_allreduce_l(3) = pabsswl 5878 combine_allreduce_l(4) = pabslwl 5879 combine_allreduce_l(5) = pemitlwl 5880 combine_allreduce_l(6) = emiss_sum_surfl 5881 combine_allreduce_l(7) = area_surfl 5882 5883 CALL MPI_ALLREDUCE( combine_allreduce_l, & 5884 combine_allreduce, & 5885 SIZE( combine_allreduce ), & 5886 MPI_REAL, & 5887 MPI_SUM, & 5888 comm2d, & 5889 ierr ) 5890 5891 pinsw = combine_allreduce(1) 5892 pinlw = combine_allreduce(2) 5893 pabssw = combine_allreduce(3) 5894 pabslw = combine_allreduce(4) 5895 pemitlw = combine_allreduce(5) 5896 emiss_sum_surf = combine_allreduce(6) 5897 area_surf = combine_allreduce(7) 5871 5898 #else 5872 pinsw = pinswl5873 pinlw = pinlwl5874 pabssw = pabsswl5875 pabslw = pabslwl5876 pemitlw = pemitlwl5899 pinsw = pinswl 5900 pinlw = pinlwl 5901 pabssw = pabsswl 5902 pabslw = pabslwl 5903 pemitlw = pemitlwl 5877 5904 emiss_sum_surf = emiss_sum_surfl 5878 area_surf = area_surfl5905 area_surf = area_surfl 5879 5906 #endif 5880 5907 5881 5908 !-- (1) albedo 5882 IF ( pinsw /= 0.0_wp ) & 5883 albedo_urb = (pinsw - pabssw) / pinsw 5909 IF ( pinsw /= 0.0_wp ) albedo_urb = ( pinsw - pabssw ) / pinsw 5884 5910 !-- (2) average emmsivity 5885 IF ( area_surf /= 0.0_wp ) & 5886 emissivity_urb = emiss_sum_surf / area_surf 5911 IF ( area_surf /= 0.0_wp ) emissivity_urb = emiss_sum_surf / area_surf 5887 5912 ! 5888 5913 !-- Temporally comment out calculation of effective radiative temperature. … … 5892 5917 !-- the effect of vertical surfaces (which contributes to LW emission) 5893 5918 !-- We simply use the ratio of the total LW to the incoming LW flux 5894 area_hor = pinlw /rad_lw_in_diff(nyn,nxl)5895 t_rad_urb = ( ( pemitlw - pabslw + emissivity_urb*pinlw) / &5896 (emissivity_urb *sigma_sb * area_hor) )**0.25_wp5919 area_hor = pinlw / rad_lw_in_diff(nyn,nxl) 5920 t_rad_urb = ( ( pemitlw - pabslw + emissivity_urb * pinlw ) / & 5921 (emissivity_urb * sigma_sb * area_hor) )**0.25_wp 5897 5922 5898 5923 IF ( debug_output_timestep ) CALL debug_message( 'radiation_interaction', 'end' )
Note: See TracChangeset
for help on using the changeset viewer.