diff --git a/FV3GFS/FV3GFS_io.F90 b/FV3GFS/FV3GFS_io.F90 index 2f2edc07..d674e7d4 100644 --- a/FV3GFS/FV3GFS_io.F90 +++ b/FV3GFS/FV3GFS_io.F90 @@ -2711,7 +2711,9 @@ subroutine register_diag_manager_controlled_diagnostics(Time, Sfcprop, IntDiag, integer, intent(in) :: nblks integer, intent(in) :: axes(4) - integer :: nb + character(len=2) :: radiation_call + character(len=6) :: scaling + integer :: n, nb integer :: index = 1 if (Model%ldiag3d) then @@ -3079,6 +3081,26 @@ subroutine register_diag_manager_controlled_diagnostics(Time, Sfcprop, IntDiag, Diag_diag_manager_controlled(index)%data(nb)%var21 => IntDiag(nb)%column_moles_dry_air_per_square_meter enddo + if (Model%do_diagnostic_radiation_with_scaled_co2) then + do n = 1,Model%n_diagnostic_radiation_calls + write (radiation_call,'(I1)') n + write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n) + + index = index + 1 + Diag_diag_manager_controlled(index)%axes = 0 + Diag_diag_manager_controlled(index)%name = 'global_mean_co2_' // radiation_call + Diag_diag_manager_controlled(index)%desc = trim(adjustl(scaling)) // 'x global mean carbon dioxide concentration' + Diag_diag_manager_controlled(index)%unit = 'volume mixing ratio' + Diag_diag_manager_controlled(index)%mod_name = 'gfs_phys' + Diag_diag_manager_controlled(index)%coarse_graining_method = AREA_WEIGHTED + allocate (Diag_diag_manager_controlled(index)%data(nblks)) + do nb = 1,nblks + Diag_diag_manager_controlled(index)%data(nb)%var2 => IntDiag(nb)%column_moles_co2_per_square_meter_with_scaled_co2(n,:) + Diag_diag_manager_controlled(index)%data(nb)%var21 => IntDiag(nb)%column_moles_dry_air_per_square_meter + enddo + enddo + endif + index = index + 1 Diag_diag_manager_controlled(index)%axes = 2 Diag_diag_manager_controlled(index)%name = 'ocean_fraction' @@ -3194,9 +3216,10 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block type (block_control_type), intent(in) :: Atm_block integer, dimension(4), intent(in) :: axes !--- local variables - integer :: idx, num, nb, nblks, nx, ny, k + integer :: idx, num, nb, nblks, nx, ny, k, n integer, allocatable :: blksz(:) character(len=2) :: xtra + character(len=6) :: scaling real(kind=kind_phys), parameter :: cn_one = 1._kind_phys real(kind=kind_phys), parameter :: cn_100 = 100._kind_phys real(kind=kind_phys), parameter :: cn_th = 1000._kind_phys @@ -3508,6 +3531,58 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%fluxr(:,1) enddo + if (Model%do_diagnostic_radiation_with_scaled_co2) then + do n = 1,Model%n_diagnostic_radiation_calls + write (xtra,'(I1)') n + write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n) + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'DSWRFtoa_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'top of atmos downward shortwave flux with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'W/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%time_avg_kind = 'rad_sw' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswrftoa_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'USWRFtoa_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'top of atmos upward shortwave flux with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'W/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%time_avg_kind = 'rad_sw' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswrftoa_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'ULWRFtoa_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'top of atmos upward longwave flux with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'W/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%time_avg_kind = 'rad_lw' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwrftoa_with_scaled_co2(n,:) + enddo + enddo + endif + idx = idx + 1 Diag(idx)%axes = 2 Diag(idx)%name = 'TCDCclm' @@ -4173,6 +4248,69 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfc(:) enddo + if (Model%do_diagnostic_radiation_with_scaled_co2) then + do n = 1,Model%n_diagnostic_radiation_calls + write (xtra,'(I1)') n + write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n) + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'DSWRF_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Interval-averaged zenith-angle-adjusted downward shortwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswsfc_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'USWRF_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Interval-averaged zenith-angle-adjusted upward shortwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswsfc_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'DLWRF_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Interval-averaged surface-temperature-adjusted downward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dlwsfc_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'ULWRF_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Interval-averaged surface-temperature-adjusted upward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%cnvfac = cn_one + Diag(idx)%time_avg = .TRUE. + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfc_with_scaled_co2(n,:) + enddo + enddo + endif + idx = idx + 1 Diag(idx)%axes = 2 Diag(idx)%name = 'sunsd_acc' @@ -5000,6 +5138,61 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block enddo endif + if (Model%do_diagnostic_radiation_with_scaled_co2) then + do n = 1,Model%n_diagnostic_radiation_calls + write (xtra,'(I1)') n + write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n) + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'DLWRFI_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Instantaneous surface-temperature-adjusted downward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dlwsfci_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'ULWRFI_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Instantaneous surface-temperature-adjusted upward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfci_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'DSWRFI_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Instantaneous zenith-angle-adjusted downward shortwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswsfci_with_scaled_co2(n,:) + enddo + + idx = idx + 1 + Diag(idx)%axes = 2 + Diag(idx)%name = 'USWRFI_with_scaled_co2_' // trim(xtra) + Diag(idx)%desc = 'Instantaneous zenith-angle-adjusted upward shortwave flux at the surface ' // trim(adjustl(scaling)) // 'xCO2' + Diag(idx)%unit = 'w/m**2' + Diag(idx)%mod_name = 'gfs_phys' + Diag(idx)%intpl_method = 'bilinear' + allocate (Diag(idx)%data(nblks)) + do nb = 1,nblks + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswsfci_with_scaled_co2(n,:) + enddo + enddo + endif + idx = idx + 1 Diag(idx)%axes = 2 Diag(idx)%name = 'dusfci' @@ -7448,13 +7641,13 @@ subroutine send_diag_manager_controlled_diagnostic_data(Time, Atm_block, IPD_Dat call mpp_error(FATAL, 'Invalid coarse-graining strategy provided.') endif endif - elseif (trim(Diag_diag_manager_controlled(index)%name) .eq. 'global_mean_co2') then + elseif (starts_with(Diag_diag_manager_controlled(index)%name, 'global_mean_co2')) then if (Diag_diag_manager_controlled(index)%id > 0) then call compute_global_mean_co2(Atm_block, IPD_Data, nx, ny, Diag_diag_manager_controlled(index), scalar) used = send_data(Diag_diag_manager_controlled(index)%id, scalar, Time) endif if (Diag_diag_manager_controlled_coarse(index)%id > 0) then - call mpp_error(FATAL, 'global_mean_co2_coarse is not a valid diagnostic; use global_mean_co2 instead.') + call mpp_error(FATAL, trim(Diag_diag_manager_controlled_coarse(index)%name) // ' is not a valid diagnostic; use ' // trim(Diag_diag_manager_controlled(index)%name) // ' instead.') endif endif endif @@ -8261,6 +8454,15 @@ subroutine store_data3D_coarse_pressure_level(id, name, method, nx, ny, nz, full used = send_data(id, coarse, Time) end subroutine store_data3D_coarse_pressure_level +function starts_with(string, prefix) + character(len=128), intent(in) :: string + character(len=*), intent(in) :: prefix + logical :: starts_with + + starts_with = string(1:len(trim(prefix))) .eq. trim(prefix) + return +end function starts_with + end module FV3GFS_io_mod diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 195652cc..06c68f16 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -884,6 +884,13 @@ subroutine GFS_physics_driver & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd & ) + if (Model%do_diagnostic_radiation_with_scaled_co2) then + call compute_diagnostics_with_scaled_co2( & + Model, Statein, Sfcprop, Coupling, Grid, Radtend, ix, im, & + levs, Diag & + ) + endif + ! ! save temp change due to radiation - need for sttp stochastic physics !--------------------------------------------------------------------- @@ -4264,6 +4271,60 @@ subroutine compute_updated_delp_following_dynamics_definition(pressure_on_interf ! Compute the mass of dry air plus all hydrometeors at the end of the physics. delp = initial_mass_of_dry_air_plus_vapor * dry_air_plus_hydrometeor_mass_fraction_after_physics end subroutine compute_updated_delp_following_dynamics_definition + + subroutine compute_diagnostics_with_scaled_co2(Model, Statein, Sfcprop, Coupling, Grid, Radtend, ix, im, levs, Diag) + type(GFS_control_type), intent(in) :: Model + type(GFS_statein_type), intent(in) :: Statein + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_radtend_type), intent(in) :: Radtend + integer, intent(in) :: ix, im, levs + type(GFS_diag_type), intent(inout) :: Diag + + integer :: n + + ! Local variables that will get reused throughout the multi-call loop + real(kind=kind_phys), dimension(im,levs) :: dtdt, dtdtc + real(kind=kind_phys), dimension(im) :: adjsfcdsw, adjsfcnsw, adjsfcdlw, & + adjsfculw, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, & + adjnirdfd, adjvisbmd, adjvisdfd, xmu, xcosz + + do n = 1, Model%n_diagnostic_radiation_calls + call dcyc2t3 & + ! --- inputs: + ( Model%solhr, Model%slag, Model%sdec, Model%cdec, Grid%sinlat, & + Grid%coslat, Grid%xlon, Radtend%coszen, Sfcprop%tsfc, & + Statein%tgrs(1,1), Radtend%tsflw, Radtend%semis, & + Coupling%sfcdsw_with_scaled_co2(n,:), Coupling%sfcnsw_with_scaled_co2(n,:), & + Coupling%sfcdlw_with_scaled_co2(n,:), Radtend%htrsw_with_scaled_co2(n,:,:), & + Radtend%swhc_with_scaled_co2(n,:,:), Radtend%htrlw_with_scaled_co2(n,:,:), & + Radtend%lwhc_with_scaled_co2(n,:,:), Coupling%nirbmui_with_scaled_co2(n,:), & + Coupling%nirdfui_with_scaled_co2(n,:), Coupling%visbmui_with_scaled_co2(n,:), & + Coupling%visdfui_with_scaled_co2(n,:), Coupling%nirbmdi_with_scaled_co2(n,:), & + Coupling%nirdfdi_with_scaled_co2(n,:), Coupling%visbmdi_with_scaled_co2(n,:), & + Coupling%visdfdi_with_scaled_co2(n,:), ix, im, levs, Model%daily_mean, & + ! --- input/output: + dtdt, dtdtc, & + ! --- outputs: + adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, adjnirbmu, adjnirdfu, & + adjvisbmu, adjvisdfu, adjnirbmd, adjnirdfd, adjvisbmd, & + adjvisdfd & + ) + + Diag%dlwsfc_with_scaled_co2(n,:) = Diag%dlwsfc_with_scaled_co2(n,:) + adjsfcdlw * Model%dtf + Diag%ulwsfc_with_scaled_co2(n,:) = Diag%ulwsfc_with_scaled_co2(n,:) + adjsfculw * Model%dtf + + Diag%dlwsfci_with_scaled_co2(n,:) = adjsfcdlw + Diag%ulwsfci_with_scaled_co2(n,:) = adjsfculw + Diag%uswsfci_with_scaled_co2(n,:) = adjsfcdsw - adjsfcnsw + Diag%dswsfci_with_scaled_co2(n,:) = adjsfcdsw + + Diag%uswsfc_with_scaled_co2(n,:) = Diag%uswsfc_with_scaled_co2(n,:) + (adjsfcdsw - adjsfcnsw) * Model%dtf + Diag%dswsfc_with_scaled_co2(n,:) = Diag%dswsfc_with_scaled_co2(n,:) + adjsfcdsw * Model%dtf + enddo + + end subroutine compute_diagnostics_with_scaled_co2 !> @} end module module_physics_driver diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 85befc1b..82fc8a97 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1199,6 +1199,7 @@ subroutine GFS_radiation_driver & integer :: me, im, lm, nfxr, nkld, ntrac integer :: i, j, k, k1, lv, itop, ibtc, nday, LP1, LMK, LMP, kd, & lla, llb, lya, lyb, kt, kb + integer :: n integer, dimension(size(Grid%xlon,1)) :: idxday integer, dimension(size(Grid%xlon,1),3) :: mbota, mtopa @@ -1388,6 +1389,12 @@ subroutine GFS_radiation_driver & ! dioxide volume mixing ratio diagnostic if requested. call compute_column_integrated_moles_of_dry_air_and_co2(Statein, gasvmr, IM, LMK, NF_VGAS, Diag) + if (Model%do_diagnostic_radiation_with_scaled_co2) then + do n = 1, Model%n_diagnostic_radiation_calls + Diag%column_moles_co2_per_square_meter_with_scaled_co2(n,:) = Model%diagnostic_radiation_co2_scale_factors(n) * Diag%column_moles_co2_per_square_meter + enddo + endif + !> - Get temperature at layer interface, and layer moisture. do k = 2, LMK do i = 1, IM @@ -1707,6 +1714,15 @@ subroutine GFS_radiation_driver & FDNCMP=scmpsw, tau067=tau067) ! --- optional endif + if (Model%do_diagnostic_radiation_with_scaled_co2) then + call diagnostic_shortwave_radiation_with_scaled_co2( & + Model, Tbd, gasvmr, plyr, plvl, tlyr, tlvl, qlyr, olyr, clouds, & ! in + faersw, sfcalb, nday, idxday, im, lm, lmk, lmp, nf_albd, & ! in + nf_aesw, nf_vgas, nf_clds, & ! in + Coupling, Radtend, Diag & ! inout + ) + endif + ! --- pass optical depth out, Linjiong Zhou diag%ctau(:,:,1) = tau067 @@ -1809,6 +1825,14 @@ subroutine GFS_radiation_driver & tau110=tau110) ! --- outputs endif + if (Model%do_diagnostic_radiation_with_scaled_co2) then + call diagnostic_longwave_radiation_with_scaled_co2( & + Model, Tbd, gasvmr, plyr, plvl, tlyr, tlvl, qlyr, olyr, clouds, & ! in + tsfg, faerlw, im, lm, lmk, lmp, nf_aelw, nf_vgas, nf_clds, & ! in + Coupling, Radtend, Diag & ! inout + ) + endif + ! --- pass emissivity out, Linjiong Zhou diag%ctau(:,:,2) = tau110 @@ -1964,6 +1988,204 @@ subroutine compute_column_integrated_moles_of_dry_air_and_co2(Statein, gasvmr, I enddo end subroutine compute_column_integrated_moles_of_dry_air_and_co2 + subroutine diagnostic_shortwave_radiation_with_scaled_co2( & + Model, Tbd, gasvmr, plyr, plvl, tlyr, tlvl, qlyr, olyr, clouds, & ! in + faersw, sfcalb, nday, idxday, im, lm, lmk, lmp, nf_albd, nf_aesw, & ! in + nf_vgas, nf_clds, & ! in + Coupling, Radtend, Diag & ! inout + ) + type(GFS_control_type), intent(in) :: Model + type(GFS_tbd_type), intent(in) :: Tbd + real(kind=kind_phys), intent(in) :: gasvmr(im,lmk,nf_vgas) + real(kind=kind_phys), intent(in) :: clouds(im,lmk,nf_clds) + real(kind=kind_phys), intent(in) :: faersw(im,lmk,nf_aesw) + real(kind=kind_phys), intent(in) :: sfcalb(im,nf_albd) + real(kind=kind_phys), intent(in), dimension(im,lmk) :: plyr, tlyr, qlyr, olyr + real(kind=kind_phys), intent(in), dimension(im,lmk + 1) :: plvl, tlvl + integer, intent(in), dimension(im) :: idxday + integer, intent(in) :: im, lm, lmk, lmp, nday, nf_albd, nf_aesw, nf_vgas, nf_clds + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_diag_type), intent(inout) :: Diag + + + integer :: i, k, k1, kd, n + real(kind=kind_phys) :: tem0d + real(kind=kind_phys), dimension(im,lmk) :: htswc, htsw0, tau067 + type (cmpfsw_type), dimension(im) :: scmpsw + real(kind=kind_phys), dimension(im,lmk,nf_vgas) :: gasvmr_with_scaled_co2 + + if (nday > 0) then + + do n = 1, Model%n_diagnostic_radiation_calls + gasvmr_with_scaled_co2 = gasvmr + gasvmr_with_scaled_co2(:,:,1) = Model%diagnostic_radiation_co2_scale_factors(n) * gasvmr(:,:,1) + + if (Model%swhtr) then + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr_with_scaled_co2, clouds, Tbd%icsdsw, faersw, & + sfcalb, Radtend%coszen, Model%solcon, & + nday, idxday, im, lmk, lmp, Model%lprnt, & + htswc, Diag%topfsw_with_scaled_co2(n,:), Radtend%sfcfsw_with_scaled_co2(n,:), & ! --- outputs + hsw0=htsw0, fdncmp=scmpsw, tau067=tau067) ! --- optional + else + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr_with_scaled_co2, clouds, Tbd%icsdsw, faersw, & + sfcalb, Radtend%coszen, Model%solcon, & + nday, idxday, im, lmk, lmp, Model%lprnt, & + htswc, Diag%topfsw_with_scaled_co2(n,:), Radtend%sfcfsw_with_scaled_co2(n,:), & ! --- outputs + fdncmp=scmpsw, tau067=tau067) ! --- optional + endif ! Model%swhtr + + do k = 1, LM + k1 = k + kd + Radtend%htrsw_with_scaled_co2(n,:,k) = htswc(:,k1) + enddo + + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%htrsw_with_scaled_co2 (n,:,k) = Radtend%htrsw_with_scaled_co2 (n,:,LM) + enddo + endif + + if (Model%swhtr) then + do k = 1, lm + k1 = k + kd + Radtend%swhc_with_scaled_co2(n,:,k) = htsw0(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%swhc_with_scaled_co2(n,:,k) = Radtend%swhc_with_scaled_co2(n,:,LM) + enddo + endif + endif + + Coupling%nirbmdi_with_scaled_co2(n,:) = scmpsw%nirbm + Coupling%nirdfdi_with_scaled_co2(n,:) = scmpsw%nirdf + Coupling%visbmdi_with_scaled_co2(n,:) = scmpsw%visbm + Coupling%visdfdi_with_scaled_co2(n,:) = scmpsw%visdf + + Coupling%nirbmui_with_scaled_co2(n,:) = scmpsw%nirbm * sfcalb(:,1) + Coupling%nirdfui_with_scaled_co2(n,:) = scmpsw%nirdf * sfcalb(:,2) + Coupling%visbmui_with_scaled_co2(n,:) = scmpsw%visbm * sfcalb(:,3) + Coupling%visdfui_with_scaled_co2(n,:) = scmpsw%visdf * sfcalb(:,4) + + enddo ! diagonstic radiation calls + + else ! nday > 0 + + Radtend%htrsw_with_scaled_co2 = 0.0 + + Radtend%sfcfsw_with_scaled_co2 = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + Diag%topfsw_with_scaled_co2 = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + + if (Model%swhtr) then + Radtend%swhc_with_scaled_co2 = 0 + endif + + Coupling%nirbmdi_with_scaled_co2 = 0.0 + Coupling%nirdfdi_with_scaled_co2 = 0.0 + Coupling%visbmdi_with_scaled_co2 = 0.0 + Coupling%visdfdi_with_scaled_co2 = 0.0 + + Coupling%nirbmui_with_scaled_co2 = 0.0 + Coupling%nirdfui_with_scaled_co2 = 0.0 + Coupling%visbmui_with_scaled_co2 = 0.0 + Coupling%visdfui_with_scaled_co2 = 0.0 + + endif ! nday > 0 + + if (Model%do_diagnostic_radiation_with_scaled_co2) then + Coupling%sfcnsw_with_scaled_co2(:,:) = Radtend%sfcfsw_with_scaled_co2(:,:)%dnfxc - Radtend%sfcfsw_with_scaled_co2(:,:)%upfxc + Coupling%sfcdsw_with_scaled_co2(:,:) = Radtend%sfcfsw_with_scaled_co2(:,:)%dnfxc + endif + + if (Model%lssav .and. Model%lsswr) then + do i = 1, IM + if (Radtend%coszen(i) > 0.) then + tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) + Diag%uswrftoa_with_scaled_co2(:,i) = Diag%uswrftoa_with_scaled_co2(:,i) + Diag%topfsw_with_scaled_co2(:,i)%upfxc * tem0d ! total sky top sw up + Diag%dswrftoa_with_scaled_co2(:,i) = Diag%dswrftoa_with_scaled_co2(:,i) + Diag%topfsw_with_scaled_co2(:,i)%dnfxc * tem0d ! top sw dn + endif + enddo + endif + end subroutine diagnostic_shortwave_radiation_with_scaled_co2 + + subroutine diagnostic_longwave_radiation_with_scaled_co2( & + Model, Tbd, gasvmr, plyr, plvl, tlyr, tlvl, qlyr, olyr, clouds, & ! in + tsfg, faerlw, im, lm, lmk, lmp, nf_aelw, nf_vgas, nf_clds, & ! in + Coupling, Radtend, Diag & ! inout + ) + type(GFS_control_type), intent(in) :: Model + type(GFS_tbd_type), intent(in) :: Tbd + real(kind=kind_phys), intent(in) :: gasvmr(im,lmk,nf_vgas) + real(kind=kind_phys), intent(in) :: clouds(im,lmk,nf_clds) + real(kind=kind_phys), intent(in) :: faerlw(im,lmk,nf_aelw) + real(kind=kind_phys), intent(in), dimension(im,lmk) :: plyr, tlyr, qlyr, olyr + real(kind=kind_phys), intent(in), dimension(im,lmk + 1) :: plvl, tlvl + real(kind=kind_phys), intent(in), dimension(im) :: tsfg + integer, intent(in) :: im, lm, lmk, lmp, nf_aelw, nf_vgas, nf_clds + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_diag_type), intent(inout) :: Diag + + integer :: k, kd, k1, n + real(kind=kind_phys), dimension(im,lmk) :: htlwc, htlw0, tau110 + real(kind=kind_phys), dimension(im,lmk,nf_vgas) :: gasvmr_with_scaled_co2 + + do n = 1, Model%n_diagnostic_radiation_calls + gasvmr_with_scaled_co2 = gasvmr + gasvmr_with_scaled_co2(:,:,1) = Model%diagnostic_radiation_co2_scale_factors(n) * gasvmr(:,:,1) + + if (Model%lwhtr) then + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr_with_scaled_co2, & ! --- inputs + clouds, Tbd%icsdlw, faerlw, Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, & + htlwc, Diag%topflw_with_scaled_co2(n,:), Radtend%sfcflw_with_scaled_co2(n,:), & ! --- outputs + hlw0=htlw0, tau110=tau110) ! --- optional + else + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr_with_scaled_co2, & ! --- inputs + clouds, Tbd%icsdlw, faerlw, Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, & + htlwc, Diag%topflw_with_scaled_co2(n,:), Radtend%sfcflw_with_scaled_co2(n,:), & ! --- outputs + tau110=tau110) ! --- optional + endif + + do k = 1, LM + k1 = k + kd + Radtend%htrlw_with_scaled_co2(n,:,k) = htlwc(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%htrlw_with_scaled_co2 (n,:,k) = Radtend%htrlw_with_scaled_co2 (n,:,LM) + enddo + endif + + if (Model%lwhtr) then + do k = 1, lm + k1 = k + kd + Radtend%lwhc_with_scaled_co2(n,:,k) = htlw0(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%lwhc_with_scaled_co2(n,:,k) = Radtend%lwhc_with_scaled_co2(n,:,LM) + enddo + endif + endif + + Coupling%sfcdlw_with_scaled_co2(n,:) = Radtend%sfcflw_with_scaled_co2(n,:)%dnfxc + + if (Model%lssav .and. Model%lslwr) then + Diag%ulwrftoa_with_scaled_co2(n,:) = Diag%ulwrftoa_with_scaled_co2(n,:) + Model%fhlwr * Diag%topflw_with_scaled_co2(n,:)%upfxc + endif + + enddo ! diagnostic radiation calls + end subroutine diagnostic_longwave_radiation_with_scaled_co2 ! !> @} !........................................! diff --git a/GFS_layer/GFS_typedefs.F90 b/GFS_layer/GFS_typedefs.F90 index 3d14847b..68eee50d 100644 --- a/GFS_layer/GFS_typedefs.F90 +++ b/GFS_layer/GFS_typedefs.F90 @@ -349,6 +349,15 @@ module GFS_typedefs real (kind=kind_phys), pointer :: visbmui(:) => null() !< sfc uv+vis beam sw upward flux (w/m2) real (kind=kind_phys), pointer :: visdfui(:) => null() !< sfc uv+vis diff sw upward flux (w/m2) + real (kind=kind_phys), pointer :: nirbmdi_with_scaled_co2(:,:) => null() !< sfc nir beam sw downward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: nirdfdi_with_scaled_co2(:,:) => null() !< sfc nir diff sw downward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: visbmdi_with_scaled_co2(:,:) => null() !< sfc uv+vis beam sw downward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: visdfdi_with_scaled_co2(:,:) => null() !< sfc uv+vis diff sw downward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: nirbmui_with_scaled_co2(:,:) => null() !< sfc nir beam sw upward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: nirdfui_with_scaled_co2(:,:) => null() !< sfc nir diff sw upward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: visbmui_with_scaled_co2(:,:) => null() !< sfc uv+vis beam sw upward flux with scaled carbon dioxide (w/m2) + real (kind=kind_phys), pointer :: visdfui_with_scaled_co2(:,:) => null() !< sfc uv+vis diff sw upward flux with scaled carbon dioxide (w/m2) + !--- In (physics only) real (kind=kind_phys), pointer :: sfcdsw(:) => null() !< total sky sfc downward sw flux ( w/m**2 ) !< GFS_radtend_type%sfcfsw%dnfxc @@ -357,6 +366,13 @@ module GFS_typedefs real (kind=kind_phys), pointer :: sfcdlw(:) => null() !< total sky sfc downward lw flux ( w/m**2 ) !< GFS_radtend_type%sfclsw%dnfxc + real (kind=kind_phys), pointer :: sfcdsw_with_scaled_co2(:,:) => null() !< total sky sfc downward sw flux with scaled carbon dioxide ( w/m**2 ) + !< GFS_radtend_type%sfcfsw%dnfxc + real (kind=kind_phys), pointer :: sfcnsw_with_scaled_co2(:,:) => null() !< total sky sfc netsw flx into ground with scaled carbon dioxide(w/m**2) + !< difference of dnfxc & upfxc from GFS_radtend_type%sfcfsw + real (kind=kind_phys), pointer :: sfcdlw_with_scaled_co2(:,:) => null() !< total sky sfc downward lw flux with scaled carbon dioxide ( w/m**2 ) + !< GFS_radtend_type%sfclsw%dnfxc + !--- incoming quantities real (kind=kind_phys), pointer :: dusfcin_cpl(:) => null() !< aoi_fld%dusfcin(item,lan) real (kind=kind_phys), pointer :: dvsfcin_cpl(:) => null() !< aoi_fld%dvsfcin(item,lan) @@ -556,6 +572,9 @@ module GFS_typedefs logical :: fixed_solhr !< flag to fix solar angle to initial time logical :: fixed_sollat !< flag to fix solar latitude logical :: daily_mean !< flag to replace cosz with daily mean value + logical :: do_diagnostic_radiation_with_scaled_co2 !< flag to call radiation multiple times with scaled carbon dioxide for diagnostic purposes (does not affect evolution of simulation) + real(kind=kind_phys), dimension(8) :: diagnostic_radiation_co2_scale_factors !< factors to scale carbon dioxide by in diagnostic radiation calls + integer :: n_diagnostic_radiation_calls !< number of diagnostic radiation calls !--- microphysical switch integer :: ncld !< cnoice of cloud scheme @@ -1034,6 +1053,32 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lwhc (:,:) => null() !< clear sky lw heating rates ( k/s ) real (kind=kind_phys), pointer :: lwhd (:,:,:) => null() !< idea sky lw heating rates ( k/s ) +!----------------------------------------- +! Optional arrays for outputs when calling the radiation code a multiple times with scaled carbon dioxide for diagnostic purposes + + type (sfcfsw_type), pointer :: sfcfsw_with_scaled_co2(:,:) => null() !< sw radiation fluxes at sfc with scaled carbon dioxide + !< [dim(im): created in grrad.f], components: + !! (check module_radsw_parameters for definition) + !!\n %upfxc - total sky upward sw flux at sfc (w/m**2) + !!\n %upfx0 - clear sky upward sw flux at sfc (w/m**2) + !!\n %dnfxc - total sky downward sw flux at sfc (w/m**2) + !!\n %dnfx0 - clear sky downward sw flux at sfc (w/m**2) + + type (sfcflw_type), pointer :: sfcflw_with_scaled_co2(:,:) => null() !< lw radiation fluxes at sfc with scaled carbon dioxide + !< [dim(im): created in grrad.f], components: + !! (check module_radlw_paramters for definition) + !!\n %upfxc - total sky upward lw flux at sfc (w/m**2) + !!\n %upfx0 - clear sky upward lw flux at sfc (w/m**2) + !!\n %dnfxc - total sky downward lw flux at sfc (w/m**2) + !!\n %dnfx0 - clear sky downward lw flux at sfc (w/m**2) + + real (kind=kind_phys), pointer :: htrsw_with_scaled_co2 (:,:,:) => null() !< swh total sky sw heating rate in k/sec with scaled carbon dioxide + real (kind=kind_phys), pointer :: htrlw_with_scaled_co2 (:,:,:) => null() !< hlw total sky lw heating rate in k/sec with scaled carbon dioxide + + real (kind=kind_phys), pointer :: swhc_with_scaled_co2 (:,:,:) => null() !< clear sky sw heating rates with scaled carbon dioxide ( k/s ) + real (kind=kind_phys), pointer :: lwhc_with_scaled_co2 (:,:,:) => null() !< clear sky lw heating rates with scaled carbon dioxide ( k/s ) + real (kind=kind_phys), pointer :: lwhd_with_scaled_co2 (:,:,:,:) => null() !< idea sky lw heating rates with scaled carbon dioxide ( k/s ) + contains procedure :: create => radtend_create !< allocate array data end type GFS_radtend_type @@ -1185,6 +1230,26 @@ module GFS_typedefs type (topflw_type), pointer :: topflw(:) => null() !< lw radiation fluxes at top, component: ! %upfxc - total sky upward lw flux at toa (w/m**2) ! %upfx0 - clear sky upward lw flux at toa (w/m**2) + type (topfsw_type), pointer :: topfsw_with_scaled_co2(:,:) => null() !< sw radiation fluxes at toa with scaled carbon dioxide, components: + ! %upfxc - total sky upward sw flux at toa (w/m**2) + ! %dnfxc - total sky downward sw flux at toa (w/m**2) + ! %upfx0 - clear sky upward sw flux at toa (w/m**2) + type (topflw_type), pointer :: topflw_with_scaled_co2(:,:) => null() !< lw radiation fluxes at top with scaled carbon dioxide, component: + ! %upfxc - total sky upward lw flux at toa (w/m**2) + ! %upfx0 - clear sky upward lw flux at toa (w/m**2) + real (kind=kind_phys), pointer :: dswrftoa_with_scaled_co2(:,:) => null() !< sw dn at toa with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: uswrftoa_with_scaled_co2(:,:) => null() !< sw up at toa with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: ulwrftoa_with_scaled_co2(:,:) => null() !< lw up at toa with scaled carbon dioxide (w/m**2) + + real (kind=kind_phys), pointer :: dlwsfci_with_scaled_co2(:,:) => null() !< instantaneous lw dn at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: ulwsfci_with_scaled_co2(:,:) => null() !< instantaneous lw up at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: dswsfci_with_scaled_co2(:,:) => null() !< instantaneous sw dn at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: uswsfci_with_scaled_co2(:,:) => null() !< instantaneous sw up at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: dlwsfc_with_scaled_co2(:,:) => null() !< interval-average lw dn at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: ulwsfc_with_scaled_co2(:,:) => null() !< interval-average lw up at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: dswsfc_with_scaled_co2(:,:) => null() !< interval-average sw dn at sfc with scaled carbon dioxide (w/m**2) + real (kind=kind_phys), pointer :: uswsfc_with_scaled_co2(:,:) => null() !< interval-average sw up at sfc with scaled carbon dioxide (w/m**2) + #if defined (USE_COSP) || defined (COSP_OFFLINE) type (cosp_type) :: cosp !< cosp output #endif @@ -1330,6 +1395,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: co2(:,:) => null() ! Vertically resolved CO2 concentration real (kind=kind_phys), pointer :: column_moles_co2_per_square_meter(:) => null() ! Moles of CO2 in column per square meter real (kind=kind_phys), pointer :: column_moles_dry_air_per_square_meter(:) => null() ! Moles of dry air in column per square meter + real (kind=kind_phys), pointer :: column_moles_co2_per_square_meter_with_scaled_co2(:,:) => null() ! Moles of CO2 in column per square meter in radiation double call !--- accumulated quantities for 3D diagnostics real (kind=kind_phys), pointer :: upd_mf (:,:) => null() !< instantaneous convective updraft mass flux @@ -1868,6 +1934,34 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%sfcnsw = clear_val Coupling%sfcdlw = clear_val + if (Model%do_diagnostic_radiation_with_scaled_co2) then + allocate (Coupling%nirbmdi_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%nirdfdi_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%visbmdi_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%visdfdi_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%nirbmui_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%nirdfui_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%visbmui_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%visdfui_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + + Coupling%nirbmdi_with_scaled_co2 = clear_val + Coupling%nirdfdi_with_scaled_co2 = clear_val + Coupling%visbmdi_with_scaled_co2 = clear_val + Coupling%visdfdi_with_scaled_co2 = clear_val + Coupling%nirbmui_with_scaled_co2 = clear_val + Coupling%nirdfui_with_scaled_co2 = clear_val + Coupling%visbmui_with_scaled_co2 = clear_val + Coupling%visdfui_with_scaled_co2 = clear_val + + allocate (Coupling%sfcdsw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%sfcnsw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Coupling%sfcdlw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + + Coupling%sfcdsw_with_scaled_co2 = clear_val + Coupling%sfcnsw_with_scaled_co2 = clear_val + Coupling%sfcdlw_with_scaled_co2 = clear_val + endif + if (Model%cplflx .or. Model%do_sppt) then allocate (Coupling%rain_cpl (IM)) allocate (Coupling%snow_cpl (IM)) @@ -2196,6 +2290,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: fixed_solhr = .false. !< flag to fix solar angle to initial time logical :: fixed_sollat = .false. !< flag to fix solar latitude logical :: daily_mean = .false. !< flag to replace cosz with daily mean value + logical :: do_diagnostic_radiation_with_scaled_co2 = .false. !< flag to call radiation a second time with scaled carbon dioxide + real(kind=kind_phys), dimension(8) :: diagnostic_radiation_co2_scale_factors = -999.0 !< factors to scale carbon dioxide by in radiation double calls !--- GFDL microphysical parameters logical :: do_sat_adj = .false. !< flag for fast saturation adjustment @@ -2487,6 +2583,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & isot, iems, iaer, iovr_sw, iovr_lw, ictm, isubc_sw, & isubc_lw, crick_proof, ccnorm, lwhtr, swhtr, nkld, & fixed_date, fixed_solhr, fixed_sollat, daily_mean, sollat, & + do_diagnostic_radiation_with_scaled_co2, & + diagnostic_radiation_co2_scale_factors, & !--- microphysical parameterizations ncld, do_sat_adj, zhao_mic, psautco, prautco, & evpco, wminco, fprcp, mg_dcs, mg_qcvar, & @@ -2664,6 +2762,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fixed_solhr = fixed_solhr Model%fixed_sollat = fixed_sollat Model%daily_mean = daily_mean + Model%do_diagnostic_radiation_with_scaled_co2 = do_diagnostic_radiation_with_scaled_co2 + Model%diagnostic_radiation_co2_scale_factors = diagnostic_radiation_co2_scale_factors + Model%n_diagnostic_radiation_calls = count(Model%diagnostic_radiation_co2_scale_factors .ne. -999.0) !--- microphysical switch Model%ncld = ncld @@ -3364,6 +3465,9 @@ subroutine control_print(Model) print *, ' fixed_solhr : ', Model%fixed_solhr print *, ' fixed_sollat : ', Model%fixed_sollat print *, ' daily_mean : ', Model%daily_mean + print *, ' do_diagnostic_radiation_with_scaled_co2 : ', Model%do_diagnostic_radiation_with_scaled_co2 + print *, ' diagnostic_radiation_co2_scale_factors : ', Model%diagnostic_radiation_co2_scale_factors + print *, ' n_diagnostic_radiation_calls : ', Model%n_diagnostic_radiation_calls print *, ' ' print *, 'microphysical switch' print *, ' ncld : ', Model%ncld @@ -3804,6 +3908,34 @@ subroutine radtend_create (Radtend, IM, Model) Radtend%lwhc = clear_val Radtend%swhc = clear_val + if (Model%do_diagnostic_radiation_with_scaled_co2) then + allocate (Radtend%sfcfsw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Radtend%sfcflw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + + Radtend%sfcfsw_with_scaled_co2%upfxc = clear_val + Radtend%sfcfsw_with_scaled_co2%upfx0 = clear_val + Radtend%sfcfsw_with_scaled_co2%dnfxc = clear_val + Radtend%sfcfsw_with_scaled_co2%dnfx0 = clear_val + Radtend%sfcflw_with_scaled_co2%upfxc = clear_val + Radtend%sfcflw_with_scaled_co2%upfx0 = clear_val + Radtend%sfcflw_with_scaled_co2%dnfxc = clear_val + Radtend%sfcflw_with_scaled_co2%dnfx0 = clear_val + + allocate(Radtend%htrsw_with_scaled_co2(Model%n_diagnostic_radiation_calls,IM,Model%levs)) + allocate(Radtend%htrlw_with_scaled_co2(Model%n_diagnostic_radiation_calls,IM,Model%levs)) + + Radtend%htrsw_with_scaled_co2 = clear_val + Radtend%htrlw_with_scaled_co2 = clear_val + + allocate (Radtend%swhc_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM,Model%levs)) + allocate (Radtend%lwhc_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM,Model%levs)) + allocate (Radtend%lwhd_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM,Model%levs,6)) + + Radtend%lwhd_with_scaled_co2 = clear_val + Radtend%lwhc_with_scaled_co2 = clear_val + Radtend%swhc_with_scaled_co2 = clear_val + endif + end subroutine radtend_create @@ -3822,6 +3954,21 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%ctau (IM,Model%levs,2)) allocate (Diag%topfsw (IM)) allocate (Diag%topflw (IM)) + if (Model%do_diagnostic_radiation_with_scaled_co2) then + allocate (Diag%topfsw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%topflw_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%dswrftoa_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%uswrftoa_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%ulwrftoa_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%dlwsfci_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%ulwsfci_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%dswsfci_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%uswsfci_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%dlwsfc_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%ulwsfc_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%dswsfc_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + allocate (Diag%uswsfc_with_scaled_co2 (Model%n_diagnostic_radiation_calls,IM)) + endif !--- Physics !--- In/Out allocate (Diag%srunoff (IM)) @@ -3952,6 +4099,10 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%eta_shal(IM,Model%levs)) allocate (Diag%co2(IM,Model%levs)) + if (Model%do_diagnostic_radiation_with_scaled_co2) then + allocate (Diag%column_moles_co2_per_square_meter_with_scaled_co2(Model%n_diagnostic_radiation_calls,IM)) + endif + !--- needed to allocate GoCart coupling fields allocate (Diag%upd_mf (IM,Model%levs)) allocate (Diag%dwn_mf (IM,Model%levs)) @@ -4105,6 +4256,24 @@ subroutine diag_rad_zero(Diag, Model) Diag%cldcov = zero endif + if (Model%do_diagnostic_radiation_with_scaled_co2) then + Diag%topfsw_with_scaled_co2%upfxc = zero + Diag%topfsw_with_scaled_co2%dnfxc = zero + Diag%topfsw_with_scaled_co2%upfx0 = zero + Diag%topflw_with_scaled_co2%upfxc = zero + Diag%topflw_with_scaled_co2%upfx0 = zero + Diag%dswrftoa_with_scaled_co2 = zero + Diag%uswrftoa_with_scaled_co2 = zero + Diag%ulwrftoa_with_scaled_co2 = zero + Diag%dlwsfci_with_scaled_co2 = zero + Diag%ulwsfci_with_scaled_co2 = zero + Diag%dswsfci_with_scaled_co2 = zero + Diag%uswsfci_with_scaled_co2 = zero + Diag%dlwsfc_with_scaled_co2 = zero + Diag%ulwsfc_with_scaled_co2 = zero + Diag%dswsfc_with_scaled_co2 = zero + Diag%uswsfc_with_scaled_co2 = zero + endif end subroutine diag_rad_zero