diff --git a/FV3GFS/FV3GFS_io.F90 b/FV3GFS/FV3GFS_io.F90 index 32ca58c9..680793f7 100644 --- a/FV3GFS/FV3GFS_io.F90 +++ b/FV3GFS/FV3GFS_io.F90 @@ -3069,10 +3069,10 @@ 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_radiation_double_call) then - do n = 1,Model%n_radiation_double_calls + 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%radiation_double_call_co2_scale_factors(n) + write (scaling,'(F6.2)') Model%diagnostic_radiation_call_co2_scale_factors(n) index = index + 1 Diag_diag_manager_controlled(index)%axes = 0 @@ -3083,7 +3083,7 @@ subroutine register_diag_manager_controlled_diagnostics(Time, Sfcprop, IntDiag, 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_radiation_double_call(n,:) + 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 @@ -3519,14 +3519,14 @@ 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_radiation_double_call) then - do n = 1,Model%n_radiation_double_calls + 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%radiation_double_call_co2_scale_factors(n) + write (scaling,'(F6.2)') Model%diagnostic_radiation_call_co2_scale_factors(n) idx = idx + 1 Diag(idx)%axes = 2 - Diag(idx)%name = 'DSWRFtoa_double_call_' // trim(xtra) + 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' @@ -3536,12 +3536,12 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswrftoa_double_call(n,:) + 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_double_call_' // trim(xtra) + 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' @@ -3551,12 +3551,12 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswrftoa_double_call(n,:) + 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_double_call_' // trim(xtra) + 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' @@ -3566,7 +3566,7 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwrftoa_double_call(n,:) + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwrftoa_with_scaled_co2(n,:) enddo enddo endif @@ -4236,14 +4236,14 @@ 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_radiation_double_call) then - do n = 1,Model%n_radiation_double_calls + 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%radiation_double_call_co2_scale_factors(n) + write (scaling,'(F6.2)') Model%diagnostic_radiation_call_co2_scale_factors(n) idx = idx + 1 Diag(idx)%axes = 2 - Diag(idx)%name = 'DSWRF_double_call_' // trim(xtra) + 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' @@ -4252,12 +4252,12 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswsfc_double_call(n,:) + 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_double_call_' // trim(xtra) + 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' @@ -4266,12 +4266,12 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswsfc_double_call(n,:) + 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_double_call_' // trim(xtra) + 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' @@ -4280,12 +4280,12 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dlwsfc_double_call(n,:) + 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_double_call_' // trim(xtra) + 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' @@ -4294,7 +4294,7 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block Diag(idx)%intpl_method = 'bilinear' allocate (Diag(idx)%data(nblks)) do nb = 1,nblks - Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfc_double_call(n,:) + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfc_with_scaled_co2(n,:) enddo enddo endif @@ -5102,57 +5102,57 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block enddo endif - if (Model%do_radiation_double_call) then - do n = 1,Model%n_radiation_double_calls + 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%radiation_double_call_co2_scale_factors(n) + write (scaling,'(F6.2)') Model%diagnostic_radiation_call_co2_scale_factors(n) idx = idx + 1 Diag(idx)%axes = 2 - Diag(idx)%name = 'DLWRFI_double_call_' // trim(xtra) + 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_double_call(n,:) + 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_double_call_' // trim(xtra) + 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_double_call(n,:) + 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_double_call_' // trim(xtra) + 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_double_call(n,:) + 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_double_call_' // trim(xtra) + 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_double_call(n,:) + Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswsfci_with_scaled_co2(n,:) enddo enddo endif diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 88ade608..92c91a70 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -884,8 +884,8 @@ subroutine GFS_physics_driver & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd & ) - if (Model%do_radiation_double_call) then - call compute_radiation_double_call_diagnostics( & + 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 & ) @@ -4234,7 +4234,7 @@ subroutine compute_updated_delp_following_dynamics_definition(pressure_on_interf 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_radiation_double_call_diagnostics(Model, Statein, Sfcprop, Coupling, Grid, Radtend, ix, im, levs, Diag) + 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 @@ -4252,38 +4252,38 @@ subroutine compute_radiation_double_call_diagnostics(Model, Statein, Sfcprop, Co adjsfculw, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, & adjnirdfd, adjvisbmd, adjvisdfd, xmu, xcosz - do n = 1, Model%n_radiation_double_calls - call dcyc2t3 & + 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_double_call(n,:), Coupling%sfcnsw_double_call(n,:), Coupling%sfcdlw_double_call(n,:), & - Radtend%htrsw_double_call(n,:,:), Radtend%swhc_double_call(n,:,:), Radtend%htrlw_double_call(n,:,:), Radtend%lwhc_double_call(n,:,:), & - Coupling%nirbmui_double_call(n,:), Coupling%nirdfui_double_call(n,:), Coupling%visbmui_double_call(n,:), & - Coupling%visdfui_double_call(n,:), Coupling%nirbmdi_double_call(n,:), Coupling%nirdfdi_double_call(n,:), & - Coupling%visbmdi_double_call(n,:), Coupling%visdfdi_double_call(n,:), ix, im, levs, & - Model%daily_mean, & + ( 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, & + dtdt, dtdtc, & ! --- outputs: - adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, adjnirdfd, adjvisbmd, & - adjvisdfd & + adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, adjnirdfd, adjvisbmd, & + adjvisdfd & ) - Diag%dlwsfc_double_call(n,:) = Diag%dlwsfc_double_call(n,:) + adjsfcdlw * Model%dtf - Diag%ulwsfc_double_call(n,:) = Diag%ulwsfc_double_call(n,:) + adjsfculw * Model%dtf + 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_double_call(n,:) = adjsfcdlw - Diag%ulwsfci_double_call(n,:) = adjsfculw - Diag%uswsfci_double_call(n,:) = adjsfcdsw - adjsfcnsw - Diag%dswsfci_double_call(n,:) = adjsfcdsw + 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_double_call(n,:) = Diag%uswsfc_double_call(n,:) + (adjsfcdsw - adjsfcnsw) * Model%dtf - Diag%dswsfc_double_call(n,:) = Diag%dswsfc_double_call(n,:) + adjsfcdsw * Model%dtf + 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_radiation_double_call_diagnostics + 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 5427a7d3..6c1857f0 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1390,9 +1390,9 @@ 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_radiation_double_call) then - do n = 1, Model%n_radiation_double_calls - Diag%column_moles_co2_per_square_meter_radiation_double_call(n,:) = Model%radiation_double_call_co2_scale_factors(n) * Diag%column_moles_co2_per_square_meter + 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_call_co2_scale_factors(n) * Diag%column_moles_co2_per_square_meter enddo endif @@ -1715,8 +1715,8 @@ subroutine GFS_radiation_driver & FDNCMP=scmpsw, tau067=tau067) ! --- optional endif - if (Model%do_radiation_double_call) then - call shortwave_radiation_double_call( & + 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 @@ -1826,8 +1826,8 @@ subroutine GFS_radiation_driver & tau110=tau110) ! --- outputs endif - if (Model%do_radiation_double_call) then - call longwave_radiation_double_call( & + 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 @@ -1990,7 +1990,7 @@ 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 shortwave_radiation_double_call( & + 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 @@ -2019,104 +2019,104 @@ subroutine shortwave_radiation_double_call( & if (nday > 0) then - do n = 1, Model%n_radiation_double_calls + do n = 1, Model%n_diagnostic_radiation_calls gasvmr_with_scaled_co2 = gasvmr - gasvmr_with_scaled_co2(:,:,1) = Model%radiation_double_call_co2_scale_factors(n) * gasvmr(:,:,1) + gasvmr_with_scaled_co2(:,:,1) = Model%diagnostic_radiation_call_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_double_call(n,:), Radtend%sfcfsw_double_call(n,:), & ! --- outputs + 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_double_call(n,:), Radtend%sfcfsw_double_call(n,:), & ! --- outputs + 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_double_call(n,:,k) = htswc(:,k1) + 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_double_call (n,:,k) = Radtend%htrsw_double_call (n,:,LM) + 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_double_call(n,:,k) = htsw0(:,k1) + 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_double_call(n,:,k) = Radtend%swhc_double_call(n,:,LM) + Radtend%swhc_with_scaled_co2(n,:,k) = Radtend%swhc_with_scaled_co2(n,:,LM) enddo endif endif - Coupling%nirbmdi_double_call(n,:) = scmpsw%nirbm - Coupling%nirdfdi_double_call(n,:) = scmpsw%nirdf - Coupling%visbmdi_double_call(n,:) = scmpsw%visbm - Coupling%visdfdi_double_call(n,:) = scmpsw%visdf + 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_double_call(n,:) = scmpsw%nirbm * sfcalb(:,1) - Coupling%nirdfui_double_call(n,:) = scmpsw%nirdf * sfcalb(:,2) - Coupling%visbmui_double_call(n,:) = scmpsw%visbm * sfcalb(:,3) - Coupling%visdfui_double_call(n,:) = scmpsw%visdf * sfcalb(:,4) + 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 ! radiation double calls + enddo ! diagonstic radiation calls else ! nday > 0 - Radtend%htrsw_double_call = 0.0 + Radtend%htrsw_with_scaled_co2 = 0.0 - Radtend%sfcfsw_double_call = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw_double_call = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 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_double_call = 0 + Radtend%swhc_with_scaled_co2 = 0 endif - Coupling%nirbmdi_double_call = 0.0 - Coupling%nirdfdi_double_call = 0.0 - Coupling%visbmdi_double_call = 0.0 - Coupling%visdfdi_double_call = 0.0 + 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_double_call = 0.0 - Coupling%nirdfui_double_call = 0.0 - Coupling%visbmui_double_call = 0.0 - Coupling%visdfui_double_call = 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_radiation_double_call) then - Coupling%sfcnsw_double_call(:,:) = Radtend%sfcfsw_double_call(:,:)%dnfxc - Radtend%sfcfsw_double_call(:,:)%upfxc - Coupling%sfcdsw_double_call(:,:) = Radtend%sfcfsw_double_call(:,:)%dnfxc + 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_double_call(:,i) = Diag%uswrftoa_double_call(:,i) + Diag%topfsw_double_call(:,i)%upfxc * tem0d ! total sky top sw up - Diag%dswrftoa_double_call(:,i) = Diag%dswrftoa_double_call(:,i) + Diag%topfsw_double_call(:,i)%dnfxc * tem0d ! top sw dn + 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 shortwave_radiation_double_call + end subroutine diagnostic_shortwave_radiation_with_scaled_co2 - subroutine longwave_radiation_double_call( & + 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 @@ -2138,56 +2138,56 @@ subroutine longwave_radiation_double_call( & 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_radiation_double_calls + do n = 1, Model%n_diagnostic_radiation_calls gasvmr_with_scaled_co2 = gasvmr - gasvmr_with_scaled_co2(:,:,1) = Model%radiation_double_call_co2_scale_factors(n) * gasvmr(:,:,1) + gasvmr_with_scaled_co2(:,:,1) = Model%diagnostic_radiation_call_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_double_call(n,:), Radtend%sfcflw_double_call(n,:), & ! --- outputs + 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_double_call(n,:), Radtend%sfcflw_double_call(n,:), & ! --- outputs + 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_double_call(n,:,k) = htlwc(:,k1) + 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_double_call (n,:,k) = Radtend%htrlw_double_call (n,:,LM) + 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_double_call(n,:,k) = htlw0(:,k1) + 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_double_call(n,:,k) = Radtend%lwhc_double_call(n,:,LM) + Radtend%lwhc_with_scaled_co2(n,:,k) = Radtend%lwhc_with_scaled_co2(n,:,LM) enddo endif endif - Coupling%sfcdlw_double_call(n,:) = Radtend%sfcflw_double_call(n,:)%dnfxc + Coupling%sfcdlw_with_scaled_co2(n,:) = Radtend%sfcflw_with_scaled_co2(n,:)%dnfxc if (Model%lssav .and. Model%lslwr) then - Diag%ulwrftoa_double_call(n,:) = Diag%ulwrftoa_double_call(n,:) + Model%fhlwr * Diag%topflw_double_call(n,:)%upfxc + Diag%ulwrftoa_with_scaled_co2(n,:) = Diag%ulwrftoa_with_scaled_co2(n,:) + Model%fhlwr * Diag%topflw_with_scaled_co2(n,:)%upfxc endif - enddo ! radiation double calls - end subroutine longwave_radiation_double_call + 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 b796ea3f..8f513d9d 100644 --- a/GFS_layer/GFS_typedefs.F90 +++ b/GFS_layer/GFS_typedefs.F90 @@ -347,14 +347,14 @@ 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_double_call(:,:) => null() !< sfc nir beam sw downward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: nirdfdi_double_call(:,:) => null() !< sfc nir diff sw downward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: visbmdi_double_call(:,:) => null() !< sfc uv+vis beam sw downward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: visdfdi_double_call(:,:) => null() !< sfc uv+vis diff sw downward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: nirbmui_double_call(:,:) => null() !< sfc nir beam sw upward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: nirdfui_double_call(:,:) => null() !< sfc nir diff sw upward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: visbmui_double_call(:,:) => null() !< sfc uv+vis beam sw upward flux with scaled carbon dioxide (w/m2) - real (kind=kind_phys), pointer :: visdfui_double_call(:,:) => null() !< sfc uv+vis diff sw upward flux with scaled carbon dioxide (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 ) @@ -364,11 +364,11 @@ 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_double_call(:,:) => null() !< total sky sfc downward sw flux with scaled carbon dioxide ( w/m**2 ) + 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_double_call(:,:) => null() !< total sky sfc netsw flx into ground with scaled carbon dioxide(w/m**2) + 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_double_call(:,:) => null() !< total sky sfc downward lw flux with scaled carbon dioxide ( w/m**2 ) + 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 @@ -570,9 +570,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_radiation_double_call !< flag to call radiation a second time with scaled carbon dioxide - real(kind=kind_phys), dimension(8) :: radiation_double_call_co2_scale_factors !< factors to scale carbon dioxide by in radiation double calls - integer :: n_radiation_double_calls !< number of radiation double calls + 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_call_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 @@ -1053,7 +1053,7 @@ module GFS_typedefs !----------------------------------------- ! Optional arrays for outputs when calling the radiation code a second time with scaled carbon dioxide - type (sfcfsw_type), pointer :: sfcfsw_double_call(:,:) => null() !< sw radiation fluxes at sfc with scaled carbon dioxide + 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) @@ -1061,7 +1061,7 @@ module GFS_typedefs !!\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_double_call(:,:) => null() !< lw radiation fluxes at sfc with scaled carbon dioxide + 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) @@ -1069,12 +1069,12 @@ module GFS_typedefs !!\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_double_call (:,:,:) => null() !< swh total sky sw heating rate in k/sec with scaled carbon dioxide - real (kind=kind_phys), pointer :: htrlw_double_call (:,:,:) => null() !< hlw total sky lw heating rate in k/sec with scaled carbon dioxide + 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_double_call (:,:,:) => null() !< clear sky sw heating rates with scaled carbon dioxide ( k/s ) - real (kind=kind_phys), pointer :: lwhc_double_call (:,:,:) => null() !< clear sky lw heating rates with scaled carbon dioxide ( k/s ) - real (kind=kind_phys), pointer :: lwhd_double_call (:,:,:,:) => null() !< idea sky lw heating rates with scaled carbon dioxide ( k/s ) + 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 @@ -1227,25 +1227,25 @@ 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_double_call(:,:) => null() !< sw radiation fluxes at toa with scaled carbon dioxide, components: + 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_double_call(:,:) => null() !< lw radiation fluxes at top with scaled carbon dioxide, component: + 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_double_call(:,:) => null() !< sw dn at toa with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: uswrftoa_double_call(:,:) => null() !< sw up at toa with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: ulwrftoa_double_call(:,:) => null() !< lw up at toa with scaled carbon dioxide (w/m**2) - - real (kind=kind_phys), pointer :: dlwsfci_double_call(:,:) => null() !< instantaneous lw dn at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: ulwsfci_double_call(:,:) => null() !< instantaneous lw up at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: dswsfci_double_call(:,:) => null() !< instantaneous sw dn at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: uswsfci_double_call(:,:) => null() !< instantaneous sw up at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: dlwsfc_double_call(:,:) => null() !< interval-average lw dn at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: ulwsfc_double_call(:,:) => null() !< interval-average lw up at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: dswsfc_double_call(:,:) => null() !< interval-average sw dn at sfc with scaled carbon dioxide (w/m**2) - real (kind=kind_phys), pointer :: uswsfc_double_call(:,:) => null() !< interval-average sw up at sfc with scaled carbon dioxide (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 @@ -1390,7 +1390,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_radiation_double_call(:,:) => null() ! Moles of CO2 in column per square meter in radiation double call + 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 @@ -1925,32 +1925,32 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%sfcnsw = clear_val Coupling%sfcdlw = clear_val - if (Model%do_radiation_double_call) then - allocate (Coupling%nirbmdi_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%nirdfdi_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%visbmdi_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%visdfdi_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%nirbmui_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%nirdfui_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%visbmui_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%visdfui_double_call (Model%n_radiation_double_calls,IM)) - - Coupling%nirbmdi_double_call = clear_val - Coupling%nirdfdi_double_call = clear_val - Coupling%visbmdi_double_call = clear_val - Coupling%visdfdi_double_call = clear_val - Coupling%nirbmui_double_call = clear_val - Coupling%nirdfui_double_call = clear_val - Coupling%visbmui_double_call = clear_val - Coupling%visdfui_double_call = clear_val - - allocate (Coupling%sfcdsw_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%sfcnsw_double_call (Model%n_radiation_double_calls,IM)) - allocate (Coupling%sfcdlw_double_call (Model%n_radiation_double_calls,IM)) - - Coupling%sfcdsw_double_call = clear_val - Coupling%sfcnsw_double_call = clear_val - Coupling%sfcdlw_double_call = 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 @@ -2281,8 +2281,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_radiation_double_call = .false. !< flag to call radiation a second time with scaled carbon dioxide - real(kind=kind_phys), dimension(8) :: radiation_double_call_co2_scale_factors = -999.0 !< factors to scale carbon dioxide by in radiation double calls + 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_call_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 @@ -2573,8 +2573,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_radiation_double_call, & - radiation_double_call_co2_scale_factors, & + do_diagnostic_radiation_with_scaled_co2, & + diagnostic_radiation_call_co2_scale_factors, & !--- microphysical parameterizations ncld, do_sat_adj, zhao_mic, psautco, prautco, & evpco, wminco, fprcp, mg_dcs, mg_qcvar, & @@ -2752,9 +2752,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_radiation_double_call = do_radiation_double_call - Model%radiation_double_call_co2_scale_factors = radiation_double_call_co2_scale_factors - Model%n_radiation_double_calls = count(Model%radiation_double_call_co2_scale_factors .ne. -999.0) + Model%do_diagnostic_radiation_with_scaled_co2 = do_diagnostic_radiation_with_scaled_co2 + Model%diagnostic_radiation_call_co2_scale_factors = diagnostic_radiation_call_co2_scale_factors + Model%n_diagnostic_radiation_calls = count(Model%diagnostic_radiation_call_co2_scale_factors .ne. -999.0) !--- microphysical switch Model%ncld = ncld @@ -3454,9 +3454,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_radiation_double_call : ', Model%do_radiation_double_call - print *, ' radiation_double_call_co2_scale_factors : ', Model%radiation_double_call_co2_scale_factors - print *, ' n_radiation_double_calls : ', Model%n_radiation_double_calls + print *, ' do_diagnostic_radiation_with_scaled_co2 : ', Model%do_diagnostic_radiation_with_scaled_co2 + print *, ' diagnostic_radiation_call_co2_scale_factors : ', Model%diagnostic_radiation_call_co2_scale_factors + print *, ' n_diagnostic_radiation_calls : ', Model%n_diagnostic_radiation_calls print *, ' ' print *, 'microphysical switch' print *, ' ncld : ', Model%ncld @@ -3896,32 +3896,32 @@ subroutine radtend_create (Radtend, IM, Model) Radtend%lwhc = clear_val Radtend%swhc = clear_val - if (Model%do_radiation_double_call) then - allocate (Radtend%sfcfsw_double_call (Model%n_radiation_double_calls,IM)) - allocate (Radtend%sfcflw_double_call (Model%n_radiation_double_calls,IM)) + 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_double_call%upfxc = clear_val - Radtend%sfcfsw_double_call%upfx0 = clear_val - Radtend%sfcfsw_double_call%dnfxc = clear_val - Radtend%sfcfsw_double_call%dnfx0 = clear_val - Radtend%sfcflw_double_call%upfxc = clear_val - Radtend%sfcflw_double_call%upfx0 = clear_val - Radtend%sfcflw_double_call%dnfxc = clear_val - Radtend%sfcflw_double_call%dnfx0 = clear_val + 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_double_call(Model%n_radiation_double_calls,IM,Model%levs)) - allocate(Radtend%htrlw_double_call(Model%n_radiation_double_calls,IM,Model%levs)) + 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_double_call = clear_val - Radtend%htrlw_double_call = clear_val + Radtend%htrsw_with_scaled_co2 = clear_val + Radtend%htrlw_with_scaled_co2 = clear_val - allocate (Radtend%swhc_double_call (Model%n_radiation_double_calls,IM,Model%levs)) - allocate (Radtend%lwhc_double_call (Model%n_radiation_double_calls,IM,Model%levs)) - allocate (Radtend%lwhd_double_call (Model%n_radiation_double_calls,IM,Model%levs,6)) + 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_double_call = clear_val - Radtend%lwhc_double_call = clear_val - Radtend%swhc_double_call = clear_val + 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 @@ -3942,20 +3942,20 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%ctau (IM,Model%levs,2)) allocate (Diag%topfsw (IM)) allocate (Diag%topflw (IM)) - if (Model%do_radiation_double_call) then - allocate (Diag%topfsw_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%topflw_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%dswrftoa_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%uswrftoa_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%ulwrftoa_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%dlwsfci_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%ulwsfci_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%dswsfci_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%uswsfci_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%dlwsfc_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%ulwsfc_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%dswsfc_double_call (Model%n_radiation_double_calls,IM)) - allocate (Diag%uswsfc_double_call (Model%n_radiation_double_calls,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 @@ -4085,8 +4085,8 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%column_moles_co2_per_square_meter(IM)) allocate (Diag%column_moles_dry_air_per_square_meter(IM)) - if (Model%do_radiation_double_call) then - allocate (Diag%column_moles_co2_per_square_meter_radiation_double_call(Model%n_radiation_double_calls,IM)) + 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 @@ -4242,23 +4242,23 @@ subroutine diag_rad_zero(Diag, Model) Diag%cldcov = zero endif - if (Model%do_radiation_double_call) then - Diag%topfsw_double_call%upfxc = zero - Diag%topfsw_double_call%dnfxc = zero - Diag%topfsw_double_call%upfx0 = zero - Diag%topflw_double_call%upfxc = zero - Diag%topflw_double_call%upfx0 = zero - Diag%dswrftoa_double_call = zero - Diag%uswrftoa_double_call = zero - Diag%ulwrftoa_double_call = zero - Diag%dlwsfci_double_call = zero - Diag%ulwsfci_double_call = zero - Diag%dswsfci_double_call = zero - Diag%uswsfci_double_call = zero - Diag%dlwsfc_double_call = zero - Diag%ulwsfc_double_call = zero - Diag%dswsfc_double_call = zero - Diag%uswsfc_double_call = zero + 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