Changeset 4187 for palm/trunk
- Timestamp:
- Aug 26, 2019 12:43:15 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
init_3d_model.f90 (modified) (2 diffs)
-
land_surface_model_mod.f90 (modified) (19 diffs)
-
plant_canopy_model_mod.f90 (modified) (7 diffs)
-
radiation_model_mod.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/init_3d_model.f90
r4186 r4187 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Deallocate temporary string array since it may be re-used to read different 28 ! input data in other modules 29 ! 30 ! 4186 2019-08-23 16:06:14Z suehring 27 31 ! Design change, use variables defined in netcdf_data_input_mod to read netcd 28 32 ! variables rather than define local ones. … … 1594 1598 1595 1599 ! 1596 !-- Finally, close the input file. 1600 !-- Finally, close the input file and deallocate temporary arrays 1601 DEALLOCATE( vars_pids ) 1602 1597 1603 CALL close_input_file( pids_id ) 1598 1604 #endif -
palm/trunk/SOURCE/land_surface_model_mod.f90
r4182 r4187 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Adjust message call in case of local checks 28 ! 29 ! 4182 2019-08-22 15:20:23Z scharf 27 30 ! Corrected "Former revisions" section 28 31 ! … … 1289 1292 message_string = 'pavement-surfaces are not allowed in ' // & 1290 1293 'combination with a non-default setting of dz_soil' 1291 CALL message( 'lsm_check_parameters', 'PA0 999', 2, 2, 0, 6, 0 )1294 CALL message( 'lsm_check_parameters', 'PA0316', 2, 2, 0, 6, 0 ) 1292 1295 ENDIF 1293 1296 ENDIF … … 3169 3172 'so that information given in ', & 3170 3173 'vegetation_pars at this point is neglected.' 3171 CALL message( 'land_surface_model_mod', 'PA0 999', 0, 0, 0, 6, 0 )3174 CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 ) 3172 3175 ELSE 3173 3176 … … 3245 3248 'so that information given in ', & 3246 3249 'vegetation_pars at this point is neglected.' 3247 CALL message( 'land_surface_model_mod', 'PA0 999', 0, 0, 0, 6, 0 )3250 CALL message( 'land_surface_model_mod', 'PA0437', 0, 0, myid, 6, 0 ) 3248 3251 ELSE 3249 3252 … … 3461 3464 'so that information given in ', & 3462 3465 'water_pars at this point is neglected.' 3463 CALL message( 'land_surface_model_mod', 'PA0 999', 0, 0, 0, 6, 0 )3466 CALL message( 'land_surface_model_mod', 'PA0645', 0, 0, myid, 6, 0 ) 3464 3467 ELSE 3465 3468 IF ( water_pars_f%pars_xy(ind_w_temp,j,i) /= & … … 3517 3520 'so that information given in ', & 3518 3521 'water_pars at this point is neglected.' 3519 CALL message( 'land_surface_model_mod', 'PA0 999', &3520 0, 0, 0, 6, 0 )3522 CALL message( 'land_surface_model_mod', 'PA0646', & 3523 0, 0, myid, 6, 0 ) 3521 3524 ELSE 3522 3525 … … 3824 3827 'so that information given in ', & 3825 3828 'pavement_pars at this point is neglected.' 3826 CALL message( 'land_surface_model_mod', 'PA0 999', 0, 0, 0, 6, 0 )3829 CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 ) 3827 3830 ELSE 3828 3831 IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= & … … 3883 3886 'so that information given in ', & 3884 3887 'pavement_pars at this point is neglected.' 3885 CALL message( 'land_surface_model_mod', 'PA0 999', 0, 0, 0, 6, 0 )3888 CALL message( 'land_surface_model_mod', 'PA0670', 0, 0, myid, 6, 0 ) 3886 3889 ELSE 3887 3890 … … 4303 4306 'than its saturation value at (k,j,i) ', k, & 4304 4307 surf_lsm_h%i(m), surf_lsm_h%j(m) 4305 CALL message( 'lsm_init', 'PA0458', 2, 2, 0, 6, 0 )4308 CALL message( 'lsm_init', 'PA0458', 2, 2, myid, 6, 0 ) 4306 4309 ENDIF 4307 4310 ENDDO … … 4319 4322 'its saturation value at (k,j,i) ', k, & 4320 4323 surf_lsm_v(l)%i(m), surf_lsm_v(l)%j(m) 4321 CALL message( 'lsm_init', 'PA0458', 2, 2, 0, 6, 0 )4324 CALL message( 'lsm_init', 'PA0458', 2, 2, myid, 6, 0 ) 4322 4325 ENDIF 4323 4326 ENDDO … … 4581 4584 message_string = 'For non-pavement surfaces the combination ' // & 4582 4585 ' lai = 0.0 and c_veg = 1.0 is not allowed.' 4583 CALL message( 'lsm_rrd_local', 'PA0 999', 2, 2, 0, 6, 0 )4586 CALL message( 'lsm_rrd_local', 'PA0671', 2, 2, 0, 6, 0 ) 4584 4587 ENDIF 4585 4588 … … 4590 4593 message_string = 'For non-pavement surfaces the combination ' // & 4591 4594 ' lai = 0.0 and c_veg = 1.0 is not allowed.' 4592 CALL message( 'lsm_rrd_local', 'PA0 999', 2, 2, 0, 6, 0 )4595 CALL message( 'lsm_rrd_local', 'PA0672', 2, 2, 0, 6, 0 ) 4593 4596 ENDIF 4594 4597 ENDDO … … 4607 4610 surf_lsm_h%i(m), surf_lsm_h%j(m) 4608 4611 CALL message( 'land_surface_model_mod', 'PA0503', & 4609 0, 0, 0, 6, 0 )4612 0, 0, myid, 6, 0 ) 4610 4613 ENDIF 4611 4614 IF ( surf_lsm_h%z0h(m) > 0.5_wp * surf_lsm_h%z_mo(m) ) THEN … … 4619 4622 surf_lsm_h%i(m), surf_lsm_h%j(m) 4620 4623 CALL message( 'land_surface_model_mod', 'PA0507', & 4621 0, 0, 0, 6, 0 )4624 0, 0, myid, 6, 0 ) 4622 4625 ENDIF 4623 4626 ENDDO … … 4635 4638 surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff 4636 4639 CALL message( 'land_surface_model_mod', 'PA0503', & 4637 0, 0, 0, 6, 0 )4640 0, 0, myid, 6, 0 ) 4638 4641 ENDIF 4639 4642 IF ( surf_lsm_v(l)%z0h(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) ) THEN … … 4648 4651 surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff 4649 4652 CALL message( 'land_surface_model_mod', 'PA0507', & 4650 0, 0, 0, 6, 0 )4653 0, 0, myid, 6, 0 ) 4651 4654 ENDIF 4652 4655 ENDDO … … 6982 6985 surf_lsm_h%i(m), surf_lsm_h%j(m) 6983 6986 CALL message( 'land_surface_model_mod', 'PA0508', & 6984 0, 0, 0, 6, 0 )6987 0, 0, myid, 6, 0 ) 6985 6988 ENDIF 6986 6989 … … 6994 6997 surf_lsm_h%i(m), surf_lsm_h%j(m) 6995 6998 CALL message( 'land_surface_model_mod', 'PA0508', & 6996 0, 0, 0, 6, 0 )6999 0, 0, myid, 6, 0 ) 6997 7000 ENDIF 6998 7001 … … 7006 7009 surf_lsm_h%i(m), surf_lsm_h%j(m) 7007 7010 CALL message( 'land_surface_model_mod', 'PA0508', & 7008 0, 0, 0, 6, 0 )7011 0, 0, myid, 6, 0 ) 7009 7012 ENDIF 7010 7013 -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4182 r4187 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Give specific error numbers instead of PA0999 30 ! 31 ! 4182 2019-08-22 15:20:23Z scharf 29 32 ! Corrected "Former revisions" section 30 33 ! … … 430 433 TRIM( coupling_char ) // ' requires ' // & 431 434 'canopy_mode = read_from_file_3d' 432 CALL message( 'pcm_check_parameters', 'PA0 999', 1, 2, 0, 6, 0 )435 CALL message( 'pcm_check_parameters', 'PA0673', 1, 2, 0, 6, 0 ) 433 436 ENDIF 434 437 … … 1066 1069 ENDDO 1067 1070 ENDDO 1071 1068 1072 CALL exchange_horiz( lad_s, nbgp ) 1069 1073 ! … … 1091 1095 ALLOCATE( pch_index_ji(nysg:nyng,nxlg:nxrg) ) 1092 1096 pch_index_ji = 0 1093 1097 1094 1098 DO i = nxl, nxr 1095 1099 DO j = nys, nyn … … 1104 1108 message_string = 'Local vegetation height on top of ' // & 1105 1109 'topography exceeds height of model domain.' 1106 CALL message( 'pcm_init', 'PA0 999', 2, 2, 0, 6, 0 )1110 CALL message( 'pcm_init', 'PA0674', 2, 2, 0, 6, 0 ) 1107 1111 ENDIF 1108 1112 … … 1114 1118 !-- Calculate global pch_index value (index of top of plant canopy from ground) 1115 1119 pch_index = MAXVAL( pch_index_ji ) 1120 1121 1116 1122 ! 1117 1123 !-- Exchange pch_index from all processors … … 1129 1135 pc_latent_rate = 0.0_wp 1130 1136 ENDIF 1131 1132 1137 ! 1133 1138 !-- Initialization of the canopy heat source distribution due to heating -
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.
