Skip to content

Commit

Permalink
Merge branch 'NOAA-GFDL:main' into shiemom_topush
Browse files Browse the repository at this point in the history
  • Loading branch information
@JosephMouallem
JosephMouallem authored Jul 10, 2024
2 parents 1b4a29f + c8c5d30 commit 0ef6494
Show file tree
Hide file tree
Showing 4 changed files with 658 additions and 4 deletions.
210 changes: 206 additions & 4 deletions FV3GFS/FV3GFS_io.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2711,7 +2711,9 @@ subroutine register_diag_manager_controlled_diagnostics(Time, Sfcprop, IntDiag,
integer, intent(in) :: nblks
integer, intent(in) :: axes(4)

integer :: nb
character(len=2) :: radiation_call
character(len=6) :: scaling
integer :: n, nb
integer :: index = 1

if (Model%ldiag3d) then
Expand Down Expand Up @@ -3079,6 +3081,26 @@ subroutine register_diag_manager_controlled_diagnostics(Time, Sfcprop, IntDiag,
Diag_diag_manager_controlled(index)%data(nb)%var21 => IntDiag(nb)%column_moles_dry_air_per_square_meter
enddo

if (Model%do_diagnostic_radiation_with_scaled_co2) then
do n = 1,Model%n_diagnostic_radiation_calls
write (radiation_call,'(I1)') n
write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n)

index = index + 1
Diag_diag_manager_controlled(index)%axes = 0
Diag_diag_manager_controlled(index)%name = 'global_mean_co2_' // radiation_call
Diag_diag_manager_controlled(index)%desc = trim(adjustl(scaling)) // 'x global mean carbon dioxide concentration'
Diag_diag_manager_controlled(index)%unit = 'volume mixing ratio'
Diag_diag_manager_controlled(index)%mod_name = 'gfs_phys'
Diag_diag_manager_controlled(index)%coarse_graining_method = AREA_WEIGHTED
allocate (Diag_diag_manager_controlled(index)%data(nblks))
do nb = 1,nblks
Diag_diag_manager_controlled(index)%data(nb)%var2 => IntDiag(nb)%column_moles_co2_per_square_meter_with_scaled_co2(n,:)
Diag_diag_manager_controlled(index)%data(nb)%var21 => IntDiag(nb)%column_moles_dry_air_per_square_meter
enddo
enddo
endif

index = index + 1
Diag_diag_manager_controlled(index)%axes = 2
Diag_diag_manager_controlled(index)%name = 'ocean_fraction'
Expand Down Expand Up @@ -3194,9 +3216,10 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
type (block_control_type), intent(in) :: Atm_block
integer, dimension(4), intent(in) :: axes
!--- local variables
integer :: idx, num, nb, nblks, nx, ny, k
integer :: idx, num, nb, nblks, nx, ny, k, n
integer, allocatable :: blksz(:)
character(len=2) :: xtra
character(len=6) :: scaling
real(kind=kind_phys), parameter :: cn_one = 1._kind_phys
real(kind=kind_phys), parameter :: cn_100 = 100._kind_phys
real(kind=kind_phys), parameter :: cn_th = 1000._kind_phys
Expand Down Expand Up @@ -3508,6 +3531,58 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%fluxr(:,1)
enddo

if (Model%do_diagnostic_radiation_with_scaled_co2) then
do n = 1,Model%n_diagnostic_radiation_calls
write (xtra,'(I1)') n
write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n)

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'DSWRFtoa_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'top of atmos downward shortwave flux with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'W/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%time_avg_kind = 'rad_sw'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswrftoa_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'USWRFtoa_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'top of atmos upward shortwave flux with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'W/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%time_avg_kind = 'rad_sw'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswrftoa_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'ULWRFtoa_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'top of atmos upward longwave flux with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'W/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%time_avg_kind = 'rad_lw'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwrftoa_with_scaled_co2(n,:)
enddo
enddo
endif

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'TCDCclm'
Expand Down Expand Up @@ -4173,6 +4248,69 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfc(:)
enddo

if (Model%do_diagnostic_radiation_with_scaled_co2) then
do n = 1,Model%n_diagnostic_radiation_calls
write (xtra,'(I1)') n
write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n)

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'DSWRF_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Interval-averaged zenith-angle-adjusted downward shortwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswsfc_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'USWRF_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Interval-averaged zenith-angle-adjusted upward shortwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswsfc_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'DLWRF_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Interval-averaged surface-temperature-adjusted downward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dlwsfc_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'ULWRF_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Interval-averaged surface-temperature-adjusted upward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%cnvfac = cn_one
Diag(idx)%time_avg = .TRUE.
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfc_with_scaled_co2(n,:)
enddo
enddo
endif

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'sunsd_acc'
Expand Down Expand Up @@ -5000,6 +5138,61 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
enddo
endif

if (Model%do_diagnostic_radiation_with_scaled_co2) then
do n = 1,Model%n_diagnostic_radiation_calls
write (xtra,'(I1)') n
write (scaling,'(F6.2)') Model%diagnostic_radiation_co2_scale_factors(n)

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'DLWRFI_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Instantaneous surface-temperature-adjusted downward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dlwsfci_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'ULWRFI_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Instantaneous surface-temperature-adjusted upward longwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%ulwsfci_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'DSWRFI_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Instantaneous zenith-angle-adjusted downward shortwave flux at the surface with ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%dswsfci_with_scaled_co2(n,:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'USWRFI_with_scaled_co2_' // trim(xtra)
Diag(idx)%desc = 'Instantaneous zenith-angle-adjusted upward shortwave flux at the surface ' // trim(adjustl(scaling)) // 'xCO2'
Diag(idx)%unit = 'w/m**2'
Diag(idx)%mod_name = 'gfs_phys'
Diag(idx)%intpl_method = 'bilinear'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%uswsfci_with_scaled_co2(n,:)
enddo
enddo
endif

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'dusfci'
Expand Down Expand Up @@ -7448,13 +7641,13 @@ subroutine send_diag_manager_controlled_diagnostic_data(Time, Atm_block, IPD_Dat
call mpp_error(FATAL, 'Invalid coarse-graining strategy provided.')
endif
endif
elseif (trim(Diag_diag_manager_controlled(index)%name) .eq. 'global_mean_co2') then
elseif (starts_with(Diag_diag_manager_controlled(index)%name, 'global_mean_co2')) then
if (Diag_diag_manager_controlled(index)%id > 0) then
call compute_global_mean_co2(Atm_block, IPD_Data, nx, ny, Diag_diag_manager_controlled(index), scalar)
used = send_data(Diag_diag_manager_controlled(index)%id, scalar, Time)
endif
if (Diag_diag_manager_controlled_coarse(index)%id > 0) then
call mpp_error(FATAL, 'global_mean_co2_coarse is not a valid diagnostic; use global_mean_co2 instead.')
call mpp_error(FATAL, trim(Diag_diag_manager_controlled_coarse(index)%name) // ' is not a valid diagnostic; use ' // trim(Diag_diag_manager_controlled(index)%name) // ' instead.')
endif
endif
endif
Expand Down Expand Up @@ -8261,6 +8454,15 @@ subroutine store_data3D_coarse_pressure_level(id, name, method, nx, ny, nz, full
used = send_data(id, coarse, Time)
end subroutine store_data3D_coarse_pressure_level

function starts_with(string, prefix)
character(len=128), intent(in) :: string
character(len=*), intent(in) :: prefix
logical :: starts_with

starts_with = string(1:len(trim(prefix))) .eq. trim(prefix)
return
end function starts_with

end module FV3GFS_io_mod


Expand Down
61 changes: 61 additions & 0 deletions GFS_layer/GFS_physics_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -884,6 +884,13 @@ subroutine GFS_physics_driver &
adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd &
)

if (Model%do_diagnostic_radiation_with_scaled_co2) then
call compute_diagnostics_with_scaled_co2( &
Model, Statein, Sfcprop, Coupling, Grid, Radtend, ix, im, &
levs, Diag &
)
endif

!
! save temp change due to radiation - need for sttp stochastic physics
!---------------------------------------------------------------------
Expand Down Expand Up @@ -4264,6 +4271,60 @@ subroutine compute_updated_delp_following_dynamics_definition(pressure_on_interf
! Compute the mass of dry air plus all hydrometeors at the end of the physics.
delp = initial_mass_of_dry_air_plus_vapor * dry_air_plus_hydrometeor_mass_fraction_after_physics
end subroutine compute_updated_delp_following_dynamics_definition

subroutine compute_diagnostics_with_scaled_co2(Model, Statein, Sfcprop, Coupling, Grid, Radtend, ix, im, levs, Diag)
type(GFS_control_type), intent(in) :: Model
type(GFS_statein_type), intent(in) :: Statein
type(GFS_sfcprop_type), intent(in) :: Sfcprop
type(GFS_coupling_type), intent(in) :: Coupling
type(GFS_grid_type), intent(in) :: Grid
type(GFS_radtend_type), intent(in) :: Radtend
integer, intent(in) :: ix, im, levs
type(GFS_diag_type), intent(inout) :: Diag

integer :: n

! Local variables that will get reused throughout the multi-call loop
real(kind=kind_phys), dimension(im,levs) :: dtdt, dtdtc
real(kind=kind_phys), dimension(im) :: adjsfcdsw, adjsfcnsw, adjsfcdlw, &
adjsfculw, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, &
adjnirdfd, adjvisbmd, adjvisdfd, xmu, xcosz

do n = 1, Model%n_diagnostic_radiation_calls
call dcyc2t3 &
! --- inputs:
( Model%solhr, Model%slag, Model%sdec, Model%cdec, Grid%sinlat, &
Grid%coslat, Grid%xlon, Radtend%coszen, Sfcprop%tsfc, &
Statein%tgrs(1,1), Radtend%tsflw, Radtend%semis, &
Coupling%sfcdsw_with_scaled_co2(n,:), Coupling%sfcnsw_with_scaled_co2(n,:), &
Coupling%sfcdlw_with_scaled_co2(n,:), Radtend%htrsw_with_scaled_co2(n,:,:), &
Radtend%swhc_with_scaled_co2(n,:,:), Radtend%htrlw_with_scaled_co2(n,:,:), &
Radtend%lwhc_with_scaled_co2(n,:,:), Coupling%nirbmui_with_scaled_co2(n,:), &
Coupling%nirdfui_with_scaled_co2(n,:), Coupling%visbmui_with_scaled_co2(n,:), &
Coupling%visdfui_with_scaled_co2(n,:), Coupling%nirbmdi_with_scaled_co2(n,:), &
Coupling%nirdfdi_with_scaled_co2(n,:), Coupling%visbmdi_with_scaled_co2(n,:), &
Coupling%visdfdi_with_scaled_co2(n,:), ix, im, levs, Model%daily_mean, &
! --- input/output:
dtdt, dtdtc, &
! --- outputs:
adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, adjnirbmu, adjnirdfu, &
adjvisbmu, adjvisdfu, adjnirbmd, adjnirdfd, adjvisbmd, &
adjvisdfd &
)

Diag%dlwsfc_with_scaled_co2(n,:) = Diag%dlwsfc_with_scaled_co2(n,:) + adjsfcdlw * Model%dtf
Diag%ulwsfc_with_scaled_co2(n,:) = Diag%ulwsfc_with_scaled_co2(n,:) + adjsfculw * Model%dtf

Diag%dlwsfci_with_scaled_co2(n,:) = adjsfcdlw
Diag%ulwsfci_with_scaled_co2(n,:) = adjsfculw
Diag%uswsfci_with_scaled_co2(n,:) = adjsfcdsw - adjsfcnsw
Diag%dswsfci_with_scaled_co2(n,:) = adjsfcdsw

Diag%uswsfc_with_scaled_co2(n,:) = Diag%uswsfc_with_scaled_co2(n,:) + (adjsfcdsw - adjsfcnsw) * Model%dtf
Diag%dswsfc_with_scaled_co2(n,:) = Diag%dswsfc_with_scaled_co2(n,:) + adjsfcdsw * Model%dtf
enddo

end subroutine compute_diagnostics_with_scaled_co2
!> @}

end module module_physics_driver
Loading

0 comments on commit 0ef6494

Please sign in to comment.