Changeset 4708 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Sep 28, 2020 5:42:58 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (32 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r4694 r4708 28 28 ! ----------------- 29 29 ! $Id$ 30 ! - Bugfix, correct mapping of RRTMG heating rates, as well as incoming/outgoing 31 ! radiation onto the topography-following grid 32 ! - add fill values to the output 33 ! 34 ! 4694 2020-09-23 15:09:19Z pavelkrc 30 35 ! Bugfix for tracing of maximum radiative fluxes 31 36 ! … … 401 406 USE indices, & 402 407 ONLY: nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 403 nzb, nzt, topo_top_ind 408 nzb, nzt, topo_top_ind, wall_flags_total_0 404 409 405 410 USE, INTRINSIC :: iso_c_binding … … 4390 4395 ! 4391 4396 !-- Save fluxes 4392 DO k = nzb, nzt+1 4393 rad_lw_in(k,:,:) = rrtm_lwdflx(0,k) 4394 rad_lw_out(k,:,:) = rrtm_lwuflx(0,k) 4397 DO i = nxl, nxr 4398 DO j = nys, nyn 4399 k_topo_l = topo_top_ind(j,i,0) 4400 DO k = k_topo_l, nzt+1 4401 rad_lw_in(k,j,i) = rrtm_lwdflx(0,k-k_topo_l+k_topo) 4402 rad_lw_out(k,j,i) = rrtm_lwuflx(0,k-k_topo_l+k_topo) 4403 ENDDO 4404 ENDDO 4395 4405 ENDDO 4396 rad_lw_in_diff(:,:) = r ad_lw_in(k_topo,:,:)4406 rad_lw_in_diff(:,:) = rrtm_lwdflx(0,k_topo) 4397 4407 ! 4398 4408 !-- Save heating rates (convert from K/d to K/h). … … 4404 4414 k_topo_l = topo_top_ind(j,i,0) 4405 4415 DO k = k_topo_l+1, nzt+1 4406 rad_lw_hr(k,j,i) = rrtm_lwhr(0,k-k_topo_l ) * d_hours_day4407 rad_lw_cs_hr(k,j,i) = rrtm_lwhrc(0,k-k_topo_l ) * d_hours_day4416 rad_lw_hr(k,j,i) = rrtm_lwhr(0,k-k_topo_l+k_topo) * d_hours_day 4417 rad_lw_cs_hr(k,j,i) = rrtm_lwhrc(0,k-k_topo_l+k_topo) * d_hours_day 4408 4418 ENDDO 4409 4419 ENDDO … … 4499 4509 ! 4500 4510 !-- Save radiation fluxes for the entire depth of the model domain 4501 DO k = nzb, nzt+1 4502 rad_sw_in(k,:,:) = rrtm_swdflx(0,k) 4503 rad_sw_out(k,:,:) = rrtm_swuflx(0,k) 4511 DO i = nxl, nxr 4512 DO j = nys, nyn 4513 k_topo_l = topo_top_ind(j,i,0) 4514 DO k = k_topo_l, nzt+1 4515 rad_sw_in(k,j,i) = rrtm_swdflx(0,k-k_topo_l+k_topo) 4516 rad_sw_out(k,j,i) = rrtm_swuflx(0,k-k_topo_l+k_topo) 4517 ENDDO 4518 ENDDO 4504 4519 ENDDO 4505 4520 !-- Save direct and diffuse SW radiation at the surface (required by RTM) … … 4509 4524 ! 4510 4525 !-- Save heating rates (convert from K/d to K/s) 4511 DO k = nzb+1, nzt+1 4512 rad_sw_hr(k,:,:) = rrtm_swhr(0,k) * d_hours_day 4513 rad_sw_cs_hr(k,:,:) = rrtm_swhrc(0,k) * d_hours_day 4526 DO i = nxl, nxr 4527 DO j = nys, nyn 4528 k_topo_l = topo_top_ind(j,i,0) 4529 DO k = k_topo_l+1, nzt+1 4530 rad_sw_hr(k,j,i) = rrtm_swhr(0,k-k_topo_l+k_topo) * d_hours_day 4531 rad_sw_cs_hr(k,j,i) = rrtm_swhrc(0,k-k_topo_l+k_topo) * d_hours_day 4532 ENDDO 4533 ENDDO 4514 4534 ENDDO 4515 4535 ! … … 4523 4543 ! 4524 4544 !-- RRTMG is called for each (j,i) grid point separately, starting at the 4525 !-- highest topography level. Here no RTM is used since average_radiation is false 4545 !-- highest topography level. Here no RTM is used since average_radiation is false. 4546 !-- In fact, this branch is only called for homogeneous flat terrain so that the topography-top 4547 !-- index is actually alwasy zero. 4526 4548 ELSE 4527 4549 ! … … 4694 4716 ENDDO 4695 4717 ! 4696 !-- Obtain topography top index (lower bound of RRTMG) 4718 !-- Obtain topography top index (lower bound of RRTMG). Is actually always zero. 4697 4719 k_topo = topo_top_ind(j,i,0) 4698 4720 … … 5829 5851 !-- Calculate tendency based on heating rate 5830 5852 DO k = nzb+1, nzt+1 5831 tend(k,j,i) = tend(k,j,i) + (rad_lw_hr(k,j,i) + rad_sw_hr(k,j,i)) & 5832 * d_exner(k) * d_seconds_hour 5853 tend(k,j,i) = tend(k,j,i) + (rad_lw_hr(k,j,i) + rad_sw_hr(k,j,i)) & 5854 * d_exner(k) * d_seconds_hour & 5855 * MERGE( 1.0_wp, 0.0_wp, & 5856 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5833 5857 ENDDO 5834 5858 … … 5848 5872 SUBROUTINE radiation_tendency ( tend ) 5849 5873 5850 USE indices, &5851 ONLY: nxl, nxr, nyn, nys5852 5853 5874 IMPLICIT NONE 5854 5875 … … 5863 5884 DO j = nys, nyn 5864 5885 DO k = nzb+1, nzt+1 5865 tend(k,j,i) = tend(k,j,i) + ( rad_lw_hr(k,j,i) & 5866 + rad_sw_hr(k,j,i) ) * d_exner(k) & 5867 * d_seconds_hour 5886 tend(k,j,i) = tend(k,j,i) + ( rad_lw_hr(k,j,i) & 5887 + rad_sw_hr(k,j,i) ) * d_exner(k) & 5888 * d_seconds_hour & 5889 * MERGE( 1.0_wp, 0.0_wp, & 5890 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5868 5891 ENDDO 5869 5892 ENDDO … … 11137 11160 !------------------------------------------------------------------------------! 11138 11161 SUBROUTINE radiation_data_output_2d( av, variable, found, grid, mode, & 11139 local_pf, two_d, nzb_do, nzt_do )11162 local_pf, two_d, nzb_do, nzt_do, fill_value ) 11140 11163 11141 11164 USE indices … … 11161 11184 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 11162 11185 11163 REAL(wp) :: fill_value = -999.0_wp!< value for the _FillValue attribute11186 REAL(wp) :: fill_value !< value for the _FillValue attribute 11164 11187 11165 11188 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< … … 11340 11363 DO j = nys, nyn 11341 11364 DO k = nzb_do, nzt_do 11342 local_pf(i,j,k) = rad_lw_in(k,j,i) 11365 local_pf(i,j,k) = MERGE( rad_lw_in(k,j,i), fill_value, & 11366 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11343 11367 ENDDO 11344 11368 ENDDO … … 11364 11388 DO j = nys, nyn 11365 11389 DO k = nzb_do, nzt_do 11366 local_pf(i,j,k) = rad_lw_out(k,j,i) 11390 local_pf(i,j,k) = MERGE( rad_lw_out(k,j,i), fill_value, & 11391 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11367 11392 ENDDO 11368 11393 ENDDO … … 11388 11413 DO j = nys, nyn 11389 11414 DO k = nzb_do, nzt_do 11390 local_pf(i,j,k) = rad_lw_cs_hr(k,j,i) 11415 local_pf(i,j,k) = MERGE( rad_lw_cs_hr(k,j,i), fill_value, & 11416 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11391 11417 ENDDO 11392 11418 ENDDO … … 11412 11438 DO j = nys, nyn 11413 11439 DO k = nzb_do, nzt_do 11414 local_pf(i,j,k) = rad_lw_hr(k,j,i) 11440 local_pf(i,j,k) = MERGE( rad_lw_hr(k,j,i), fill_value, & 11441 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11415 11442 ENDDO 11416 11443 ENDDO … … 11436 11463 DO j = nys, nyn 11437 11464 DO k = nzb_do, nzt_do 11438 local_pf(i,j,k) = rad_sw_in(k,j,i) 11465 local_pf(i,j,k) = MERGE( rad_sw_in(k,j,i), fill_value, & 11466 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11439 11467 ENDDO 11440 11468 ENDDO … … 11460 11488 DO j = nys, nyn 11461 11489 DO k = nzb_do, nzt_do 11462 local_pf(i,j,k) = rad_sw_out(k,j,i) 11490 local_pf(i,j,k) = MERGE( rad_sw_out(k,j,i), fill_value, & 11491 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11463 11492 ENDDO 11464 11493 ENDDO … … 11484 11513 DO j = nys, nyn 11485 11514 DO k = nzb_do, nzt_do 11486 local_pf(i,j,k) = rad_sw_cs_hr(k,j,i) 11515 local_pf(i,j,k) = MERGE( rad_sw_cs_hr(k,j,i), fill_value, & 11516 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11487 11517 ENDDO 11488 11518 ENDDO … … 11508 11538 DO j = nys, nyn 11509 11539 DO k = nzb_do, nzt_do 11510 local_pf(i,j,k) = rad_sw_hr(k,j,i) 11540 local_pf(i,j,k) = MERGE( rad_sw_hr(k,j,i), fill_value, & 11541 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11511 11542 ENDDO 11512 11543 ENDDO … … 11542 11573 !> Subroutine defining 3D output variables 11543 11574 !------------------------------------------------------------------------------! 11544 SUBROUTINE radiation_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )11575 SUBROUTINE radiation_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do ) 11545 11576 11546 11577 … … 11561 11592 LOGICAL :: found !< 11562 11593 11563 REAL(wp) :: fill_value = -999.0_wp!< value for the _FillValue attribute11594 REAL(wp) :: fill_value !< value for the _FillValue attribute 11564 11595 11565 11596 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< … … 11626 11657 DO j = nys, nyn 11627 11658 DO k = nzb_do, nzt_do 11628 local_pf(i,j,k) = rad_sw_in(k,j,i) 11659 local_pf(i,j,k) = MERGE( rad_sw_in(k,j,i), fill_value, & 11660 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11629 11661 ENDDO 11630 11662 ENDDO … … 11649 11681 DO j = nys, nyn 11650 11682 DO k = nzb_do, nzt_do 11651 local_pf(i,j,k) = rad_sw_out(k,j,i) 11683 local_pf(i,j,k) = MERGE( rad_sw_out(k,j,i), fill_value, & 11684 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11652 11685 ENDDO 11653 11686 ENDDO … … 11672 11705 DO j = nys, nyn 11673 11706 DO k = nzb_do, nzt_do 11674 local_pf(i,j,k) = rad_sw_cs_hr(k,j,i) 11707 local_pf(i,j,k) = MERGE( rad_sw_cs_hr(k,j,i), fill_value, & 11708 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11675 11709 ENDDO 11676 11710 ENDDO … … 11695 11729 DO j = nys, nyn 11696 11730 DO k = nzb_do, nzt_do 11697 local_pf(i,j,k) = rad_sw_hr(k,j,i) 11731 local_pf(i,j,k) = MERGE( rad_sw_hr(k,j,i), fill_value, & 11732 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11698 11733 ENDDO 11699 11734 ENDDO … … 11718 11753 DO j = nys, nyn 11719 11754 DO k = nzb_do, nzt_do 11720 local_pf(i,j,k) = rad_lw_in(k,j,i) 11755 local_pf(i,j,k) = MERGE( rad_lw_in(k,j,i), fill_value, & 11756 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11721 11757 ENDDO 11722 11758 ENDDO … … 11741 11777 DO j = nys, nyn 11742 11778 DO k = nzb_do, nzt_do 11743 local_pf(i,j,k) = rad_lw_out(k,j,i) 11779 local_pf(i,j,k) = MERGE( rad_lw_out(k,j,i), fill_value, & 11780 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11744 11781 ENDDO 11745 11782 ENDDO … … 11764 11801 DO j = nys, nyn 11765 11802 DO k = nzb_do, nzt_do 11766 local_pf(i,j,k) = rad_lw_cs_hr(k,j,i) 11803 local_pf(i,j,k) = MERGE( rad_lw_cs_hr(k,j,i), fill_value, & 11804 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11767 11805 ENDDO 11768 11806 ENDDO … … 11787 11825 DO j = nys, nyn 11788 11826 DO k = nzb_do, nzt_do 11789 local_pf(i,j,k) = rad_lw_hr(k,j,i) 11827 local_pf(i,j,k) = MERGE( rad_lw_hr(k,j,i), fill_value, & 11828 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 11790 11829 ENDDO 11791 11830 ENDDO … … 12227 12266 DO k = 1, mask_size_l(mid,3) 12228 12267 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 12229 mask_j(mid,j),mask_i(mid,i)) 12268 mask_j(mid,j), & 12269 mask_i(mid,i)) 12230 12270 ENDDO 12231 12271 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
