From e0fe8ee3960a8655e6a15cd08d20be5eeb9f9301 Mon Sep 17 00:00:00 2001 From: Spencer Clark Date: Wed, 26 Jun 2024 16:14:19 -0400 Subject: [PATCH] Some renaming for clarity The modifications here are aimed to remove reference to "double calls" since this PR enables up to 8 additional calls. They are also aimed to make it clear that these radiation calls do not affect the evolution of the simulation, and that the diagnostics pertain to what we get when we scale CO2 (as opposed to some other constituent of the atmosphere). --- FV3GFS/FV3GFS_io.F90 | 70 ++++---- GFS_layer/GFS_physics_driver.F90 | 52 +++--- GFS_layer/GFS_radiation_driver.F90 | 114 ++++++------- GFS_layer/GFS_typedefs.F90 | 252 ++++++++++++++--------------- 4 files changed, 244 insertions(+), 244 deletions(-) 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