Changeset 3992 for palm/trunk
- Timestamp:
- May 22, 2019 4:49:38 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3987 r3992 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Bugfix in rrtmg radiation branch in a nested run when the lowest prognistic 31 ! grid points in a child domain are all inside topography 32 ! 33 ! 3987 2019-05-22 09:52:13Z kanani 30 34 ! Introduce alternative switch for debug output during timestepping 31 35 ! … … 3470 3474 3471 3475 INTEGER(iwp) :: i, j, k, l, m, n !< loop indices 3476 INTEGER(iwp) :: k_topo_l !< topography top index 3472 3477 INTEGER(iwp) :: k_topo !< topography top index 3473 3478 … … 3528 3533 IF ( average_radiation ) THEN 3529 3534 3535 k_topo_l = MINVAL( get_topography_top_index( 's' ) ) 3536 #if defined( __parallel ) 3537 CALL MPI_ALLREDUCE( k_topo_l, k_topo, 1, MPI_INTEGER, MPI_MIN, & 3538 comm2d, ierr) 3539 #else 3540 k_topo = k_topo_l 3541 #endif 3542 3530 3543 rrtm_asdir(1) = albedo_urb 3531 3544 rrtm_asdif(1) = albedo_urb … … 3535 3548 rrtm_emis = emissivity_urb 3536 3549 ! 3537 !-- Calculate mean pt profile. Actually, only one height level is required.3550 !-- Calculate mean pt profile. 3538 3551 CALL calc_mean_profile( pt, 4 ) 3539 3552 pt_av = hom(:, 1, 4, 0) … … 3545 3558 ! 3546 3559 !-- Prepare profiles of temperature and H2O volume mixing ratio 3547 rrtm_tlev(0, nzb+1) = t_rad_urb3560 rrtm_tlev(0,k_topo+1) = t_rad_urb 3548 3561 3549 3562 IF ( bulk_cloud_model ) THEN … … 3593 3606 !-- Linear interpolate to zw grid. Loop reaches one level further up 3594 3607 !-- due to the staggered grid in RRTMG 3595 DO k = nzb+2, nzt+83608 DO k = k_topo+2, nzt+8 3596 3609 rrtm_tlev(0,k) = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k) - & 3597 3610 rrtm_tlay(0,k-1)) & … … 3599 3612 * ( rrtm_plev(0,k) - rrtm_play(0,k-1) ) 3600 3613 ENDDO 3601 3602 3603 3614 ! 3604 3615 !-- Calculate liquid water path and cloud fraction for each column. … … 3640 3651 rrtm_tsfc = t_rad_urb 3641 3652 3642 IF ( lw_radiation ) THEN 3653 IF ( lw_radiation ) THEN 3654 ! 3655 !-- Due to technical reasons, copy optical depth to dummy arguments 3656 !-- which are allocated on the exact size as the rrtmg_lw is called. 3657 !-- As one dimesion is allocated with zero size, compiler complains 3658 !-- that rank of the array does not match that of the 3659 !-- assumed-shaped arguments in the RRTMG library. In order to 3660 !-- avoid this, write to dummy arguments and give pass the entire 3661 !-- dummy array. Seems to be the only existing work-around. 3662 ALLOCATE( rrtm_lw_taucld_dum(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1) ) 3663 ALLOCATE( rrtm_lw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1) ) 3664 3665 rrtm_lw_taucld_dum = & 3666 rrtm_lw_taucld(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1) 3667 rrtm_lw_tauaer_dum = & 3668 rrtm_lw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1) 3643 3669 3644 CALL rrtmg_lw( 1, nzt_rad , rrtm_icld , rrtm_idrv ,& 3645 rrtm_play , rrtm_plev , rrtm_tlay , rrtm_tlev ,& 3646 rrtm_tsfc , rrtm_h2ovmr , rrtm_o3vmr , rrtm_co2vmr ,& 3647 rrtm_ch4vmr , rrtm_n2ovmr , rrtm_o2vmr , rrtm_cfc11vmr ,& 3648 rrtm_cfc12vmr , rrtm_cfc22vmr, rrtm_ccl4vmr , rrtm_emis ,& 3649 rrtm_inflglw , rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr ,& 3650 rrtm_lw_taucld , rrtm_cicewp , rrtm_cliqwp , rrtm_reice ,& 3651 rrtm_reliq , rrtm_lw_tauaer, & 3652 rrtm_lwuflx , rrtm_lwdflx , rrtm_lwhr , & 3653 rrtm_lwuflxc , rrtm_lwdflxc , rrtm_lwhrc , & 3654 rrtm_lwuflx_dt , rrtm_lwuflxc_dt ) 3655 3670 ! CALL rrtmg_lw( 1, nzt_rad , rrtm_icld , rrtm_idrv ,& 3671 ! rrtm_play , rrtm_plev , rrtm_tlay , rrtm_tlev ,& 3672 ! rrtm_tsfc , rrtm_h2ovmr , rrtm_o3vmr , rrtm_co2vmr ,& 3673 ! rrtm_ch4vmr , rrtm_n2ovmr , rrtm_o2vmr , rrtm_cfc11vmr ,& 3674 ! rrtm_cfc12vmr , rrtm_cfc22vmr, rrtm_ccl4vmr , rrtm_emis ,& 3675 ! rrtm_inflglw , rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr ,& 3676 ! rrtm_lw_taucld , rrtm_cicewp , rrtm_cliqwp , rrtm_reice ,& 3677 ! rrtm_reliq , rrtm_lw_tauaer, & 3678 ! rrtm_lwuflx , rrtm_lwdflx , rrtm_lwhr , & 3679 ! rrtm_lwuflxc , rrtm_lwdflxc , rrtm_lwhrc , & 3680 ! rrtm_lwuflx_dt , rrtm_lwuflxc_dt ) 3681 3682 CALL rrtmg_lw( 1, & 3683 nzt_rad-k_topo, & 3684 rrtm_icld, & 3685 rrtm_idrv, & 3686 rrtm_play(:,k_topo+1:), & 3687 rrtm_plev(:,k_topo+1:), & 3688 rrtm_tlay(:,k_topo+1:), & 3689 rrtm_tlev(:,k_topo+1:), & 3690 rrtm_tsfc, & 3691 rrtm_h2ovmr(:,k_topo+1:), & 3692 rrtm_o3vmr(:,k_topo+1:), & 3693 rrtm_co2vmr(:,k_topo+1:), & 3694 rrtm_ch4vmr(:,k_topo+1:), & 3695 rrtm_n2ovmr(:,k_topo+1:), & 3696 rrtm_o2vmr(:,k_topo+1:), & 3697 rrtm_cfc11vmr(:,k_topo+1:), & 3698 rrtm_cfc12vmr(:,k_topo+1:), & 3699 rrtm_cfc22vmr(:,k_topo+1:), & 3700 rrtm_ccl4vmr(:,k_topo+1:), & 3701 rrtm_emis, & 3702 rrtm_inflglw, & 3703 rrtm_iceflglw, & 3704 rrtm_liqflglw, & 3705 rrtm_cldfr(:,k_topo+1:), & 3706 rrtm_lw_taucld_dum, & 3707 rrtm_cicewp(:,k_topo+1:), & 3708 rrtm_cliqwp(:,k_topo+1:), & 3709 rrtm_reice(:,k_topo+1:), & 3710 rrtm_reliq(:,k_topo+1:), & 3711 rrtm_lw_tauaer_dum, & 3712 rrtm_lwuflx(:,k_topo:), & 3713 rrtm_lwdflx(:,k_topo:), & 3714 rrtm_lwhr(:,k_topo+1:), & 3715 rrtm_lwuflxc(:,k_topo:), & 3716 rrtm_lwdflxc(:,k_topo:), & 3717 rrtm_lwhrc(:,k_topo+1:), & 3718 rrtm_lwuflx_dt(:,k_topo:), & 3719 rrtm_lwuflxc_dt(:,k_topo:) ) 3720 3721 DEALLOCATE ( rrtm_lw_taucld_dum ) 3722 DEALLOCATE ( rrtm_lw_tauaer_dum ) 3656 3723 ! 3657 3724 !-- Save fluxes … … 3660 3727 rad_lw_out(k,:,:) = rrtm_lwuflx(0,k) 3661 3728 ENDDO 3662 rad_lw_in_diff(:,:) = rad_lw_in( 0,:,:)3729 rad_lw_in_diff(:,:) = rad_lw_in(k_topo,:,:) 3663 3730 ! 3664 3731 !-- Save heating rates (convert from K/d to K/h). … … 3668 3735 DO i = nxl, nxr 3669 3736 DO j = nys, nyn 3670 k_topo = get_topography_top_index_ji( j, i, 's' )3671 DO k = k_topo +1, nzt+13672 rad_lw_hr(k,j,i) = rrtm_lwhr(0,k-k_topo ) * d_hours_day3673 rad_lw_cs_hr(k,j,i) = rrtm_lwhrc(0,k-k_topo ) * d_hours_day3737 k_topo_l = get_topography_top_index_ji( j, i, 's' ) 3738 DO k = k_topo_l+1, nzt+1 3739 rad_lw_hr(k,j,i) = rrtm_lwhr(0,k-k_topo_l) * d_hours_day 3740 rad_lw_cs_hr(k,j,i) = rrtm_lwhrc(0,k-k_topo_l) * d_hours_day 3674 3741 ENDDO 3675 3742 ENDDO … … 3679 3746 3680 3747 IF ( sw_radiation .AND. sun_up ) THEN 3681 CALL rrtmg_sw( 1, nzt_rad , rrtm_icld , rrtm_iaer ,& 3682 rrtm_play , rrtm_plev , rrtm_tlay , rrtm_tlev ,& 3683 rrtm_tsfc , rrtm_h2ovmr , rrtm_o3vmr , rrtm_co2vmr ,& 3684 rrtm_ch4vmr , rrtm_n2ovmr , rrtm_o2vmr , rrtm_asdir ,& 3685 rrtm_asdif , rrtm_aldir , rrtm_aldif , zenith ,& 3686 0.0_wp , day_of_year , solar_constant, rrtm_inflgsw ,& 3687 rrtm_iceflgsw , rrtm_liqflgsw , rrtm_cldfr , rrtm_sw_taucld ,& 3688 rrtm_sw_ssacld , rrtm_sw_asmcld, rrtm_sw_fsfcld, rrtm_cicewp ,& 3689 rrtm_cliqwp , rrtm_reice , rrtm_reliq , rrtm_sw_tauaer ,& 3690 rrtm_sw_ssaaer , rrtm_sw_asmaer, rrtm_sw_ecaer , rrtm_swuflx ,& 3691 rrtm_swdflx , rrtm_swhr , rrtm_swuflxc , rrtm_swdflxc ,& 3692 rrtm_swhrc , rrtm_dirdflux , rrtm_difdflux ) 3748 ! 3749 !-- Due to technical reasons, copy optical depths and other 3750 !-- to dummy arguments which are allocated on the exact size as the 3751 !-- rrtmg_sw is called. 3752 !-- As one dimesion is allocated with zero size, compiler complains 3753 !-- that rank of the array does not match that of the 3754 !-- assumed-shaped arguments in the RRTMG library. In order to 3755 !-- avoid this, write to dummy arguments and give pass the entire 3756 !-- dummy array. Seems to be the only existing work-around. 3757 ALLOCATE( rrtm_sw_taucld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) ) 3758 ALLOCATE( rrtm_sw_ssacld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) ) 3759 ALLOCATE( rrtm_sw_asmcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) ) 3760 ALLOCATE( rrtm_sw_fsfcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) ) 3761 ALLOCATE( rrtm_sw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) ) 3762 ALLOCATE( rrtm_sw_ssaaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) ) 3763 ALLOCATE( rrtm_sw_asmaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) ) 3764 ALLOCATE( rrtm_sw_ecaer_dum(0:0,k_topo+1:nzt_rad+1,1:naerec+1) ) 3765 3766 rrtm_sw_taucld_dum = rrtm_sw_taucld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) 3767 rrtm_sw_ssacld_dum = rrtm_sw_ssacld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) 3768 rrtm_sw_asmcld_dum = rrtm_sw_asmcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) 3769 rrtm_sw_fsfcld_dum = rrtm_sw_fsfcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) 3770 rrtm_sw_tauaer_dum = rrtm_sw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) 3771 rrtm_sw_ssaaer_dum = rrtm_sw_ssaaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) 3772 rrtm_sw_asmaer_dum = rrtm_sw_asmaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) 3773 rrtm_sw_ecaer_dum = rrtm_sw_ecaer(0:0,k_topo+1:nzt_rad+1,1:naerec+1) 3774 ! CALL rrtmg_sw( 1, nzt_rad , rrtm_icld , rrtm_iaer ,& 3775 ! rrtm_play , rrtm_plev , rrtm_tlay , rrtm_tlev ,& 3776 ! rrtm_tsfc , rrtm_h2ovmr , rrtm_o3vmr , rrtm_co2vmr ,& 3777 ! rrtm_ch4vmr , rrtm_n2ovmr , rrtm_o2vmr , rrtm_asdir ,& 3778 ! rrtm_asdif , rrtm_aldir , rrtm_aldif , zenith ,& 3779 ! 0.0_wp , day_of_year , solar_constant, rrtm_inflgsw ,& 3780 ! rrtm_iceflgsw , rrtm_liqflgsw , rrtm_cldfr , rrtm_sw_taucld ,& 3781 ! rrtm_sw_ssacld , rrtm_sw_asmcld, rrtm_sw_fsfcld, rrtm_cicewp ,& 3782 ! rrtm_cliqwp , rrtm_reice , rrtm_reliq , rrtm_sw_tauaer ,& 3783 ! rrtm_sw_ssaaer , rrtm_sw_asmaer, rrtm_sw_ecaer , rrtm_swuflx ,& 3784 ! rrtm_swdflx , rrtm_swhr , rrtm_swuflxc , rrtm_swdflxc ,& 3785 ! rrtm_swhrc , rrtm_dirdflux , rrtm_difdflux ) 3786 CALL rrtmg_sw( 1, & 3787 nzt_rad-k_topo, & 3788 rrtm_icld, & 3789 rrtm_iaer, & 3790 rrtm_play(:,k_topo+1:nzt_rad+1), & 3791 rrtm_plev(:,k_topo+1:nzt_rad+2), & 3792 rrtm_tlay(:,k_topo+1:nzt_rad+1), & 3793 rrtm_tlev(:,k_topo+1:nzt_rad+2), & 3794 rrtm_tsfc, & 3795 rrtm_h2ovmr(:,k_topo+1:nzt_rad+1), & 3796 rrtm_o3vmr(:,k_topo+1:nzt_rad+1), & 3797 rrtm_co2vmr(:,k_topo+1:nzt_rad+1), & 3798 rrtm_ch4vmr(:,k_topo+1:nzt_rad+1), & 3799 rrtm_n2ovmr(:,k_topo+1:nzt_rad+1), & 3800 rrtm_o2vmr(:,k_topo+1:nzt_rad+1), & 3801 rrtm_asdir, & 3802 rrtm_asdif, & 3803 rrtm_aldir, & 3804 rrtm_aldif, & 3805 zenith, & 3806 0.0_wp, & 3807 day_of_year, & 3808 solar_constant, & 3809 rrtm_inflgsw, & 3810 rrtm_iceflgsw, & 3811 rrtm_liqflgsw, & 3812 rrtm_cldfr(:,k_topo+1:nzt_rad+1), & 3813 rrtm_sw_taucld_dum, & 3814 rrtm_sw_ssacld_dum, & 3815 rrtm_sw_asmcld_dum, & 3816 rrtm_sw_fsfcld_dum, & 3817 rrtm_cicewp(:,k_topo+1:nzt_rad+1), & 3818 rrtm_cliqwp(:,k_topo+1:nzt_rad+1), & 3819 rrtm_reice(:,k_topo+1:nzt_rad+1), & 3820 rrtm_reliq(:,k_topo+1:nzt_rad+1), & 3821 rrtm_sw_tauaer_dum, & 3822 rrtm_sw_ssaaer_dum, & 3823 rrtm_sw_asmaer_dum, & 3824 rrtm_sw_ecaer_dum, & 3825 rrtm_swuflx(:,k_topo:nzt_rad+1), & 3826 rrtm_swdflx(:,k_topo:nzt_rad+1), & 3827 rrtm_swhr(:,k_topo+1:nzt_rad+1), & 3828 rrtm_swuflxc(:,k_topo:nzt_rad+1), & 3829 rrtm_swdflxc(:,k_topo:nzt_rad+1), & 3830 rrtm_swhrc(:,k_topo+1:nzt_rad+1), & 3831 rrtm_dirdflux(:,k_topo:nzt_rad+1), & 3832 rrtm_difdflux(:,k_topo:nzt_rad+1) ) 3833 3834 DEALLOCATE( rrtm_sw_taucld_dum ) 3835 DEALLOCATE( rrtm_sw_ssacld_dum ) 3836 DEALLOCATE( rrtm_sw_asmcld_dum ) 3837 DEALLOCATE( rrtm_sw_fsfcld_dum ) 3838 DEALLOCATE( rrtm_sw_tauaer_dum ) 3839 DEALLOCATE( rrtm_sw_ssaaer_dum ) 3840 DEALLOCATE( rrtm_sw_asmaer_dum ) 3841 DEALLOCATE( rrtm_sw_ecaer_dum ) 3693 3842 3694 3843 ! … … 3700 3849 ENDDO 3701 3850 !-- - direct and diffuse SW at urban-surface-layer (required by RTM) 3702 rad_sw_in_dir(:,:) = rrtm_dirdflux(0, nzb)3703 rad_sw_in_diff(:,:) = rrtm_difdflux(0, nzb)3851 rad_sw_in_dir(:,:) = rrtm_dirdflux(0,k_topo) 3852 rad_sw_in_diff(:,:) = rrtm_difdflux(0,k_topo) 3704 3853 3705 3854 !
Note: See TracChangeset
for help on using the changeset viewer.
