diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 3216c7bbb1..c58920ba60 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -49,12 +49,13 @@ module MOM_surface_forcing use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl -use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type, register_scalar_field +use MOM_diag_mediator, only : safe_alloc_ptr, time_type, register_scalar_field use MOM_domains, only : pass_vector, pass_var, global_field_sum, BITWISE_EXACT_SUM use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, deallocate_forcing_type +use MOM_forcing_type, only : forcing, forcing_diags +use MOM_forcing_type, only : register_forcing_type_diags, deallocate_forcing_type use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, write_version_number @@ -82,7 +83,7 @@ module MOM_surface_forcing #include -public convert_IOB_to_fluxes, surface_forcing_init, average_forcing, ice_ocn_bnd_type_chksum +public convert_IOB_to_fluxes, surface_forcing_init, ice_ocn_bnd_type_chksum public forcing_save_restart type, public :: surface_forcing_CS ; private @@ -155,41 +156,36 @@ module MOM_surface_forcing logical :: first_call = .true. ! True if convert_IOB_to_fluxes has not been ! called yet. - integer :: id_taux = -1, id_tauy = -1, id_ustar = -1 - integer :: id_PminusE = -1, id_evap = -1, id_precip = -1 - integer :: id_liq_precip = -1, id_froz_precip = -1, id_virt_precip = -1 - integer :: id_liq_runoff = -1, id_froz_runoff = -1 - integer :: id_runoff_hflx = -1, id_calving_hflx = -1 - integer :: id_Net_Heating = -1, id_sw = -1, id_LwLatSens = -1, id_buoy = -1 - integer :: id_LW = -1, id_lat = -1, id_sens = -1 - integer :: id_psurf = -1, id_saltflux = -1, id_saltFluxIn = -1, id_TKE_tidal = -1 - integer :: id_saltFluxRestore = -1, id_saltFluxGlobalAdj = -1 integer :: id_srestore = -1 ! An id number for time_interp_external. + + ! Diagnostics handles + type(forcing_diags), public :: handles + !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: u_flux =>NULL() ! i-direction wind stress (Pa) - real, pointer, dimension(:,:) :: v_flux =>NULL() ! j-direction wind stress (Pa) - real, pointer, dimension(:,:) :: t_flux =>NULL() ! sensible heat flux (W/m2) - real, pointer, dimension(:,:) :: q_flux =>NULL() ! specific humidity flux (kg/m2/s) - real, pointer, dimension(:,:) :: salt_flux =>NULL()! salt flux (kg/m2/s) - real, pointer, dimension(:,:) :: lw_flux =>NULL() ! long wave radiation (w/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dir => NULL() ! direct visible sw radiation (w/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dif => NULL() ! diffuse visible sw radiation (w/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dir => NULL() ! direct Near InfraRed sw radiation (w/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dif => NULL() ! diffuse Near InfraRed sw radiation (w/m2) - real, pointer, dimension(:,:) :: lprec =>NULL() ! mass flux of liquid precip (kg/m2/s) - real, pointer, dimension(:,:) :: fprec =>NULL() ! mass flux of frozen precip (kg/m2/s) - real, pointer, dimension(:,:) :: runoff =>NULL() ! mass flux of liquid runoff (kg/m2/s) - real, pointer, dimension(:,:) :: calving =>NULL() ! mass flux of frozen runoff (kg/m2/s) - real, pointer, dimension(:,:) :: runoff_hflx =>NULL() ! heat flux associated with liquid runoff (w/m2) - real, pointer, dimension(:,:) :: calving_hflx =>NULL()! heat flux associated with frozen runoff (w/m2) - real, pointer, dimension(:,:) :: p =>NULL() ! pressure of overlying ice and atmosphere - ! on ocean surface (Pa) - real, pointer, dimension(:,:) :: mi =>NULL() ! mass of ice (kg/m2) + real, pointer, dimension(:,:) :: u_flux =>NULL() ! i-direction wind stress (Pa) + real, pointer, dimension(:,:) :: v_flux =>NULL() ! j-direction wind stress (Pa) + real, pointer, dimension(:,:) :: t_flux =>NULL() ! sensible heat flux (W/m2) + real, pointer, dimension(:,:) :: q_flux =>NULL() ! specific humidity flux (kg/m2/s) + real, pointer, dimension(:,:) :: salt_flux =>NULL() ! salt flux (kg/m2/s) + real, pointer, dimension(:,:) :: lw_flux =>NULL() ! long wave radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() ! direct visible sw radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() ! diffuse visible sw radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() ! direct Near InfraRed sw radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() ! diffuse Near InfraRed sw radiation (W/m2) + real, pointer, dimension(:,:) :: lprec =>NULL() ! mass flux of liquid precip (kg/m2/s) + real, pointer, dimension(:,:) :: fprec =>NULL() ! mass flux of frozen precip (kg/m2/s) + real, pointer, dimension(:,:) :: runoff =>NULL() ! mass flux of liquid runoff (kg/m2/s) + real, pointer, dimension(:,:) :: calving =>NULL() ! mass flux of frozen runoff (kg/m2/s) + real, pointer, dimension(:,:) :: runoff_hflx =>NULL() ! heat content of liquid runoff (W/m2) + real, pointer, dimension(:,:) :: calving_hflx =>NULL() ! heat content of frozen runoff (W/m2) + real, pointer, dimension(:,:) :: p =>NULL() ! pressure of overlying ice and atmosphere + ! on ocean surface (Pa) + real, pointer, dimension(:,:) :: mi =>NULL() ! mass of ice (kg/m2) integer :: xtype ! REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes ! A structure that may contain an ! array of named fields used for @@ -257,7 +253,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, real :: PmE_adj_total ! The globally area integrated PmE_adj, in kg s-1. real :: net_FW_avg ! The globally averaged net fresh water input to the ! ocean/sea-ice system, in kg m-2 s-1. - real :: Sflux_adj_total ! The globally area integrated salt flux adjustment, in kg s-1. real :: Irho0 ! The inverse of the mean density in m3 kg-1. real :: taux2, tauy2 ! The squared wind stresses in Pa2. real :: tau_mag ! The magnitude of the wind stress, in Pa. @@ -289,39 +284,45 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 PmE_adj_total = 0.0 - Sflux_adj_total = 0.0 + fluxes%Sflux_adj_total = 0.0 restore_salinity = .false. if (present(restore_salt)) restore_salinity = restore_salt if (CS%first_call) then - call safe_alloc_ptr(fluxes%taux,IsdB,IedB,jsd,jed) ; fluxes%taux(:,:) = 0.0 - call safe_alloc_ptr(fluxes%tauy,isd,ied,JsdB,JedB) ; fluxes%tauy(:,:) = 0.0 - call safe_alloc_ptr(fluxes%ustar,isd,ied,jsd,jed) ; fluxes%ustar(:,:) = 0.0 - call safe_alloc_ptr(fluxes%evap,isd,ied,jsd,jed) ; fluxes%evap(:,:) = 0.0 - call safe_alloc_ptr(fluxes%liq_precip,isd,ied,jsd,jed) ; fluxes%liq_precip(:,:) = 0.0 - call safe_alloc_ptr(fluxes%froz_precip,isd,ied,jsd,jed) ; fluxes%froz_precip(:,:) = 0.0 - call safe_alloc_ptr(fluxes%virt_precip,isd,ied,jsd,jed) ; fluxes%virt_precip(:,:) = 0.0 - call safe_alloc_ptr(fluxes%sw,isd,ied,jsd,jed) ; fluxes%sw(:,:) = 0.0 - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) ; fluxes%sw_vis_dir(:,:) = 0.0 - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) ; fluxes%sw_vis_dif(:,:) = 0.0 - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) ; fluxes%sw_nir_dir(:,:) = 0.0 - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) ; fluxes%sw_nir_dif(:,:) = 0.0 - call safe_alloc_ptr(fluxes%lw,isd,ied,jsd,jed) ; fluxes%lw(:,:) = 0.0 - call safe_alloc_ptr(fluxes%latent,isd,ied,jsd,jed) ; fluxes%latent(:,:) = 0.0 - call safe_alloc_ptr(fluxes%sens,isd,ied,jsd,jed) ; fluxes%sens(:,:) = 0.0 - call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) ; fluxes%p_surf(:,:) = 0.0 - call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) ; fluxes%p_surf_full(:,:) = 0.0 - call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) ; fluxes%salt_flux(:,:) = 0.0 - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) ; fluxes%TKE_tidal(:,:) = 0.0 - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) ; fluxes%ustar_tidal(:,:) = 0.0 - call safe_alloc_ptr(fluxes%liq_runoff,isd,ied,jsd,jed) ; fluxes%liq_runoff(:,:) = 0.0 - call safe_alloc_ptr(fluxes%froz_runoff,isd,ied,jsd,jed) ; fluxes%froz_runoff(:,:) = 0.0 + call safe_alloc_ptr(fluxes%taux,IsdB,IedB,jsd,jed) ; fluxes%taux(:,:) = 0.0 + call safe_alloc_ptr(fluxes%tauy,isd,ied,JsdB,JedB) ; fluxes%tauy(:,:) = 0.0 + call safe_alloc_ptr(fluxes%ustar,isd,ied,jsd,jed) ; fluxes%ustar(:,:) = 0.0 + call safe_alloc_ptr(fluxes%evap,isd,ied,jsd,jed) ; fluxes%evap(:,:) = 0.0 + call safe_alloc_ptr(fluxes%liq_precip,isd,ied,jsd,jed) ; fluxes%liq_precip(:,:) = 0.0 + call safe_alloc_ptr(fluxes%froz_precip,isd,ied,jsd,jed) ; fluxes%froz_precip(:,:) = 0.0 + call safe_alloc_ptr(fluxes%virt_precip,isd,ied,jsd,jed) ; fluxes%virt_precip(:,:) = 0.0 + call safe_alloc_ptr(fluxes%seaice_melt,isd,ied,jsd,jed) ; fluxes%seaice_melt(:,:) = 0.0 + call safe_alloc_ptr(fluxes%sw,isd,ied,jsd,jed) ; fluxes%sw(:,:) = 0.0 + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) ; fluxes%sw_vis_dir(:,:) = 0.0 + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) ; fluxes%sw_vis_dif(:,:) = 0.0 + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) ; fluxes%sw_nir_dir(:,:) = 0.0 + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) ; fluxes%sw_nir_dif(:,:) = 0.0 + call safe_alloc_ptr(fluxes%lw,isd,ied,jsd,jed) ; fluxes%lw(:,:) = 0.0 + call safe_alloc_ptr(fluxes%latent,isd,ied,jsd,jed) ; fluxes%latent(:,:) = 0.0 + call safe_alloc_ptr(fluxes%latent_evap,isd,ied,jsd,jed) ; fluxes%latent_evap(:,:) = 0.0 + call safe_alloc_ptr(fluxes%latent_fprec,isd,ied,jsd,jed) ; fluxes%latent_fprec(:,:) = 0.0 + call safe_alloc_ptr(fluxes%latent_calve,isd,ied,jsd,jed) ; fluxes%latent_calve(:,:) = 0.0 + call safe_alloc_ptr(fluxes%sens,isd,ied,jsd,jed) ; fluxes%sens(:,:) = 0.0 + call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) ; fluxes%p_surf(:,:) = 0.0 + call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) ; fluxes%p_surf_full(:,:) = 0.0 + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) ; fluxes%salt_flux(:,:) = 0.0 + call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) ; fluxes%salt_flux_in(:,:) = 0.0 + call safe_alloc_ptr(fluxes%salt_flux_restore,isd,ied,jsd,jed) ; fluxes%salt_flux_restore(:,:) = 0.0 + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) ; fluxes%TKE_tidal(:,:) = 0.0 + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) ; fluxes%ustar_tidal(:,:) = 0.0 + call safe_alloc_ptr(fluxes%liq_runoff,isd,ied,jsd,jed) ; fluxes%liq_runoff(:,:) = 0.0 + call safe_alloc_ptr(fluxes%froz_runoff,isd,ied,jsd,jed) ; fluxes%froz_runoff(:,:) = 0.0 if (ASSOCIATED(IOB%calving_hflx)) then - call safe_alloc_ptr(fluxes%calving_hflx,isd,ied,jsd,jed) ; fluxes%calving_hflx(:,:) = 0.0 + call safe_alloc_ptr(fluxes%calving_heat_content,isd,ied,jsd,jed) ; fluxes%calving_heat_content(:,:) = 0.0 endif if (ASSOCIATED(IOB%runoff_hflx)) then - call safe_alloc_ptr(fluxes%runoff_hflx,isd,ied,jsd,jed) ; fluxes%runoff_hflx(:,:) = 0.0 + call safe_alloc_ptr(fluxes%runoff_heat_content,isd,ied,jsd,jed) ; fluxes%runoff_heat_content(:,:) = 0.0 endif if (CS%rigid_sea_ice) then call safe_alloc_ptr(fluxes%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -358,8 +359,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & (CS%basin_mask(i,j)*open_ocn_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 work_sum(i,j) = G%areaT(i,j)*fluxes%salt_flux(i,j) + fluxes%salt_flux_restore(i,j) = fluxes%salt_flux(i,j) enddo; enddo - Sflux_adj_total = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer) / & + fluxes%Sflux_adj_total = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer) / & CS%area_surf else do j=js,je ; do i=is,ie @@ -380,8 +382,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, ! for backward compatibility. See section below where ! CS%adjust_net_fresh_water_to_zero is tested to be true. endif - if ((CS%id_saltFluxRestore > 0)) call post_data(CS%id_saltFluxRestore, fluxes%salt_flux, CS%diag) - if ((CS%id_saltFluxGlobalAdj > 0)) call post_data(CS%id_saltFluxGlobalAdj, Sflux_adj_total, CS%diag) endif wind_stagger = CS%wind_stagger @@ -429,10 +429,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, fluxes%virt_precip(i,j) = (pme_adj(i,j) - PmE_adj_total) * G%mask2dT(i,j) if (ASSOCIATED(IOB%calving_hflx)) & - fluxes%calving_hflx(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%calving_heat_content(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (ASSOCIATED(IOB%runoff_hflx)) & - fluxes%runoff_hflx(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%runoff_heat_content(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (ASSOCIATED(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -441,12 +441,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 - if (ASSOCIATED(IOB%fprec)) & - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*hlf - if (ASSOCIATED(IOB%calving)) & - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*hlf - if (ASSOCIATED(IOB%q_flux)) & - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*hlv + if (ASSOCIATED(IOB%fprec)) & + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*hlf ; & + fluxes%latent_fprec(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*hlf + if (ASSOCIATED(IOB%calving)) & + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*hlf ; & + fluxes%latent_calve(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*hlf + if (ASSOCIATED(IOB%q_flux)) & + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*hlv ; & + fluxes%latent_evap(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*hlv + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) if (ASSOCIATED(IOB%sw_flux_vis_dir)) & @@ -463,7 +467,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, if (restore_salinity .and. CS%salt_restore_as_sflux) then do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j)-Sflux_adj_total) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j)-fluxes%Sflux_adj_total) enddo ; enddo else do j=js,je ; do i=is,ie @@ -474,8 +478,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, if (ASSOCIATED(IOB%salt_flux)) then do j=js,je ; do i=is,ie fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( -IOB%salt_flux(i-i0,j-j0) ) enddo ; enddo - if (CS%id_saltFluxIn > 0) call post_data(CS%id_saltFluxIn, -IOB%salt_flux, CS%diag, mask=G%mask2dT(is:ie,js:je)) endif !### if (associated(CS%ctrl_forcing_CSp)) then @@ -649,107 +653,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, state, call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_fluxes -subroutine average_forcing(fluxes, dt, G, CS) - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt - type(ocean_grid_type), intent(in) :: G - type(surface_forcing_CS), pointer :: CS -! This subroutine offers forcing fields for time averaging. These -! fields must first be registered in surface_forcing_init (below). -! This subroutine will typically not be modified, except when new -! forcing fields are added. -! -! Arguments: fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields are unallocated. -! (in) dt - The amount of time over which to average. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. - - real, dimension(SZI_(G),SZJ_(G)) :: sum - - call cpu_clock_begin(id_clock_forcing) - - if (query_averaging_enabled(CS%diag)) then - if ((CS%id_taux > 0) .and. ASSOCIATED(fluxes%taux)) & - call post_data(CS%id_taux, fluxes%taux, CS%diag) - if ((CS%id_tauy > 0) .and. ASSOCIATED(fluxes%tauy)) & - call post_data(CS%id_tauy, fluxes%tauy, CS%diag) - if ((CS%id_ustar > 0) .and. ASSOCIATED(fluxes%ustar)) & - call post_data(CS%id_ustar, fluxes%ustar, CS%diag) - - if (CS%id_PminusE > 0) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:)+fluxes%liq_precip(:,:) - if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:)+fluxes%froz_precip(:,:) - if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:)+fluxes%evap(:,:) - if (ASSOCIATED(fluxes%liq_runoff)) sum(:,:) = sum(:,:)+fluxes%liq_runoff(:,:) - if (ASSOCIATED(fluxes%froz_runoff)) sum(:,:) = sum(:,:)+fluxes%froz_runoff(:,:) - if (ASSOCIATED(fluxes%virt_precip)) sum(:,:) = sum(:,:)+fluxes%virt_precip(:,:) - call post_data(CS%id_PminusE, sum, CS%diag) - endif - - if ((CS%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & - call post_data(CS%id_evap, fluxes%evap, CS%diag) - if ((CS%id_precip > 0) .and. ASSOCIATED(fluxes%liq_precip) & - .and. ASSOCIATED(fluxes%froz_precip)) then - sum(:,:) = fluxes%liq_precip(:,:) + fluxes%froz_precip(:,:) - call post_data(CS%id_precip, sum, CS%diag) - endif - - if ((CS%id_liq_precip > 0) .and. ASSOCIATED(fluxes%liq_precip)) & - call post_data(CS%id_liq_precip, fluxes%liq_precip, CS%diag) - if ((CS%id_froz_precip > 0) .and. ASSOCIATED(fluxes%froz_precip)) & - call post_data(CS%id_froz_precip, fluxes%froz_precip, CS%diag) - if ((CS%id_virt_precip > 0) .and. ASSOCIATED(fluxes%virt_precip)) & - call post_data(CS%id_virt_precip, fluxes%virt_precip, CS%diag) - if ((CS%id_liq_runoff > 0) .and. ASSOCIATED(fluxes%liq_runoff)) & - call post_data(CS%id_liq_runoff, fluxes%liq_runoff, CS%diag) - if ((CS%id_froz_runoff > 0) .and. ASSOCIATED(fluxes%froz_runoff)) & - call post_data(CS%id_froz_runoff, fluxes%froz_runoff, CS%diag) - - if ((CS%id_runoff_hflx > 0) .and. ASSOCIATED(fluxes%runoff_hflx)) & - call post_data(CS%id_runoff_hflx, fluxes%runoff_hflx, CS%diag) - if ((CS%id_calving_hflx > 0) .and. ASSOCIATED(fluxes%calving_hflx)) & - call post_data(CS%id_calving_hflx, fluxes%calving_hflx, CS%diag) - - if (CS%id_Net_Heating > 0) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%LW)) sum(:,:) = sum(:,:) + fluxes%LW(:,:) - if (ASSOCIATED(fluxes%latent)) sum(:,:) = sum(:,:) + fluxes%latent(:,:) - if (ASSOCIATED(fluxes%sens)) sum(:,:) = sum(:,:) + fluxes%sens(:,:) - if (ASSOCIATED(fluxes%SW)) sum(:,:) = sum(:,:) + fluxes%SW(:,:) - call post_data(CS%id_Net_Heating, sum, CS%diag) - endif - if ((CS%id_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & - ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then - sum(:,:) = (fluxes%lw(:,:) + fluxes%latent(:,:)) + fluxes%sens(:,:) - call post_data(CS%id_LwLatSens, sum, CS%diag) - endif - - if ((CS%id_sw > 0) .and. ASSOCIATED(fluxes%sw)) & - call post_data(CS%id_sw, fluxes%sw, CS%diag) - if ((CS%id_LW > 0) .and. ASSOCIATED(fluxes%LW)) & - call post_data(CS%id_LW, fluxes%LW, CS%diag) - if ((CS%id_lat > 0) .and. ASSOCIATED(fluxes%latent)) & - call post_data(CS%id_lat, fluxes%latent, CS%diag) - if ((CS%id_sens > 0) .and. ASSOCIATED(fluxes%sens)) & - call post_data(CS%id_sens, fluxes%sens, CS%diag) - - if ((CS%id_psurf > 0) .and. ASSOCIATED(fluxes%p_surf)) & - call post_data(CS%id_psurf, fluxes%p_surf, CS%diag) - if ((CS%id_saltflux > 0) .and. ASSOCIATED(fluxes%salt_flux)) & - call post_data(CS%id_saltflux, fluxes%salt_flux, CS%diag) - if ((CS%id_TKE_tidal > 0) .and. ASSOCIATED(fluxes%TKE_tidal)) & - call post_data(CS%id_TKE_tidal, fluxes%TKE_tidal, CS%diag) - - if ((CS%id_buoy > 0) .and. ASSOCIATED(fluxes%buoy)) & - call post_data(CS%id_buoy, fluxes%buoy, CS%diag) - endif - - call cpu_clock_end(id_clock_forcing) -end subroutine average_forcing - subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) type(surface_forcing_CS), pointer :: CS @@ -991,71 +894,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt) "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif - CS%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, Time, & - 'Zonal Wind Stress', 'Pascal', standard_name='surface_downward_x_stress') - CS%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & - 'Meridional Wind Stress', 'Pascal', standard_name='surface_downward_y_stress') - CS%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & - 'Surface friction velocity', 'meter second-1') - - if (CS%use_temperature) then - CS%id_PminusE = register_diag_field('ocean_model', 'PmE', diag%axesT1, Time, & - 'Net fresh water flux (P-E+C+R)', 'kilogram meter-2 second-1') - CS%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & - 'Evaporation at ocean surface (usually negative)', 'kilogram meter-2 second-1') - CS%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & - 'Precipitation into ocean', 'kilogram meter-2 second-1') - CS%id_froz_precip = register_diag_field('ocean_model', 'froz_precip', diag%axesT1, Time, & - 'Frozen Precipitation into ocean', 'kilogram meter-2 second-1', & - standard_name='snowfall_flux') - CS%id_liq_precip = register_diag_field('ocean_model', 'liq_precip', diag%axesT1, Time, & - 'Liquid Precipitation into ocean', 'kilogram meter-2 second-1', & - standard_name='rainfall_flux') - CS%id_virt_precip = register_diag_field('ocean_model', 'virt_precip', diag%axesT1, Time, & - 'Virtual Precipitation into ocean (due to salinity restoring)', 'kilogram meter-2 second-1') - CS%id_froz_runoff = register_diag_field('ocean_model', 'froz_runoff', diag%axesT1, Time, & - 'Frozen runoff (calving) into ocean', 'kilogram meter-2 second-1', & - standard_name='water_flux_into_sea_water_from_icebergs') - CS%id_liq_runoff = register_diag_field('ocean_model', 'liq_runoff', diag%axesT1, Time, & - 'Liquid runoff (rivers) into ocean', 'kilogram meter-2 second-1', & - standard_name='water_flux_into_sea_water_from_rivers') - CS%id_calving_hflx = register_diag_field('ocean_model', 'calving_hflx', diag%axesT1, Time, & - 'Heat content of frozen runoff (calving) into ocean', 'Watt meter-2') - CS%id_runoff_hflx = register_diag_field('ocean_model', 'runoff_hflx', diag%axesT1, Time, & - 'Heat content of liquid runoff (rivers) into ocean', 'Watt meter-2') - - CS%id_Net_Heating = register_diag_field('ocean_model', 'Net_Heat', diag%axesT1, Time, & - 'Net Surface Heating of Ocean', 'Watt meter-2') - CS%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, Time, & - 'Shortwave radiation flux into ocean', 'Watt meter-2', & - standard_name='surface_net_downward_shortwave_flux') - CS%id_LwLatSens = register_diag_field('ocean_model', 'LwLatSens', diag%axesT1, Time, & - 'Combined longwave, latent, and sensible heating', 'Watt meter-2') - CS%id_lw = register_diag_field('ocean_model', 'LW', diag%axesT1, Time, & - 'Longwave radiation flux into ocean', 'Watt meter-2', & - standard_name='surface_net_downward_longwave_flux') - CS%id_lat = register_diag_field('ocean_model', 'latent', diag%axesT1, Time, & - 'Latent heat flux into ocean due to fusion and evaporation', 'Watt meter-2') - CS%id_sens = register_diag_field('ocean_model', 'sensible', diag%axesT1, Time, & - 'Sensible heat flux into ocean', 'Watt meter-2', & - standard_name='surface_downward_sensible_heat_flux') - - CS%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, Time, & - 'Pressure at ice-ocean or atmosphere-ocean interface', 'Pascal') - CS%id_saltflux = register_diag_field('ocean_model', 'salt_flux', diag%axesT1, Time, & - 'Salt flux into ocean at surface', 'kilogram meter-2 second-1') - CS%id_saltFluxIn = register_diag_field('ocean_model', 'salt_flux_in', diag%axesT1, Time, & - 'Salt flux into ocean at surface from coupler', 'kilogram meter-2 second-1') - CS%id_saltFluxRestore = register_diag_field('ocean_model', 'salt_flux_restore', diag%axesT1, Time, & - 'Salt flux into ocean at surface due to restoring term', 'kilogram meter-2 second-1') - CS%id_saltFluxGlobalAdj = register_scalar_field('ocean_model', 'salt_flux_global_restoring_adjustment', Time, diag, & - 'Adjustment needed to balance net global salt flux into ocean at surface', 'kilogram meter-2 second-1') - CS%id_TKE_tidal = register_diag_field('ocean_model', 'TKE_tidal', diag%axesT1, Time, & - 'Tidal source of BBL mixing', 'Watt meter-2') - else - CS%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, Time, & - 'Buoyancy forcing', 'meter2 second-3') - endif + call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles) if (present(restore_salt)) then ; if (restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 75c12d675e..1a3c7cf0db 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -43,7 +43,7 @@ module ocean_model_mod use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : forcing +use MOM_forcing_type, only : forcing, forcing_diagnostics use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type use MOM_io, only : close_file, file_exists, read_data, write_version_number @@ -52,7 +52,7 @@ module ocean_model_mod use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS use MOM_string_functions, only : uppercase use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : average_forcing, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : ice_ocn_bnd_type_chksum use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing, only : forcing_save_restart use MOM_time_manager, only : time_type, get_time, set_time, operator(>) @@ -156,7 +156,7 @@ module ocean_model_mod ! restore salinity to a specified value. real :: press_to_z ! A conversion factor between pressure and ocean ! depth in m, usually 1/(rho_0*g), in m Pa-1. - real :: C_p ! The heat capacity of seawater, in J K-1 kg-1. + real :: C_p ! The heat capacity of seawater, in J K-1 kg-1. type(directories) :: dirs ! A structure containing several relevant directory paths. type(forcing) :: fluxes ! A structure containing pointers to @@ -166,8 +166,8 @@ module ocean_model_mod type(ocean_grid_type), pointer :: grid => NULL() ! A pointer to a grid structure ! containing metrics and related information. type(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(surface_forcing_CS), pointer :: forcing_CSp => NULL() - type(sum_output_CS), pointer :: sum_output_CSp => NULL() + type(surface_forcing_CS), pointer :: forcing_CSp => NULL() + type(sum_output_CS), pointer :: sum_output_CSp => NULL() end type ocean_state_type contains @@ -371,7 +371,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%nstep = OS%nstep + 1 call enable_averaging(time_step, OS%Time, OS%MOM_CSp%diag) - call average_forcing(OS%fluxes, time_step, OS%grid, OS%forcing_CSp) + call forcing_diagnostics(OS%fluxes, OS%state, time_step, OS%grid, OS%MOM_CSp%diag, OS%forcing_CSp%handles) call accumulate_net_input(OS%fluxes, OS%state, time_step, OS%grid, OS%sum_output_CSp) call disable_averaging(OS%MOM_CSp%diag) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index d548fe7386..7289912fed 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -98,7 +98,7 @@ module MOM_surface_forcing #include -public set_forcing, surface_forcing_init, average_forcing, forcing_save_restart +public set_forcing, surface_forcing_init, forcing_diagnostics, forcing_save_restart type, public :: surface_forcing_CS ; private logical :: use_temperature ! If true, temperature and salinity are used as @@ -165,7 +165,7 @@ module MOM_surface_forcing character(len=80) :: stress_x_var, stress_y_var integer :: id_taux = -1, id_tauy = -1, id_ustar = -1 - integer :: id_PminusE = -1, id_evap = -1, id_precip = -1 + integer :: id_pmepr = -1, id_evap = -1, id_precip = -1 integer :: id_liq_precip = -1, id_froz_precip = -1, id_virt_precip = -1 integer :: id_liq_runoff = -1, id_froz_runoff = -1 integer :: id_runoff_hflx = -1, id_calving_hflx = -1 @@ -669,6 +669,10 @@ subroutine buoyancy_forcing_from_files(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(isd:ied,jsd:jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(isd:ied,jsd:jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the fresh water forcing by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. @@ -904,6 +908,10 @@ subroutine buoyancy_forcing_zero(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(G%isd:G%ied,G%jsd:G%jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(G%isd:G%ied,G%jsd:G%jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the heat fluxes by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. @@ -1000,6 +1008,10 @@ subroutine buoyancy_forcing_linear(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(G%isd:G%ied,G%jsd:G%jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(G%isd:G%ied,G%jsd:G%jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the heat fluxes by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. @@ -1084,7 +1096,7 @@ subroutine buoyancy_forcing_linear(state, fluxes, day, dt, G, CS) end subroutine buoyancy_forcing_linear -subroutine average_forcing(fluxes, dt, G, CS) +subroutine forcing_diagnostics(fluxes, dt, G, CS) type(forcing), intent(in) :: fluxes real, intent(in) :: dt type(ocean_grid_type), intent(in) :: G @@ -1113,15 +1125,15 @@ subroutine average_forcing(fluxes, dt, G, CS) if ((CS%id_ustar > 0) .and. ASSOCIATED(fluxes%ustar)) & call post_data(CS%id_ustar, fluxes%ustar, CS%diag) - if (CS%id_PminusE > 0) then + if (CS%id_pmepr > 0) then sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:)+fluxes%liq_precip(:,:) - if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:)+fluxes%froz_precip(:,:) - if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:)+fluxes%evap(:,:) - if (ASSOCIATED(fluxes%liq_runoff)) sum(:,:) = sum(:,:)+fluxes%liq_runoff(:,:) - if (ASSOCIATED(fluxes%froz_runoff)) sum(:,:) = sum(:,:)+fluxes%froz_runoff(:,:) - if (ASSOCIATED(fluxes%virt_precip)) sum(:,:) = sum(:,:)+fluxes%virt_precip(:,:) - call post_data(CS%id_PminusE, sum, CS%diag) + if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:)+fluxes%liq_precip(:,:) + if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:)+fluxes%froz_precip(:,:) + if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:)+fluxes%evap(:,:) + if (ASSOCIATED(fluxes%liq_runoff)) sum(:,:) = sum(:,:)+fluxes%liq_runoff(:,:) + if (ASSOCIATED(fluxes%froz_runoff)) sum(:,:) = sum(:,:)+fluxes%froz_runoff(:,:) + if (ASSOCIATED(fluxes%virt_precip)) sum(:,:) = sum(:,:)+fluxes%virt_precip(:,:) + call post_data(CS%id_pmepr, sum, CS%diag) endif if ((CS%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & @@ -1185,7 +1197,7 @@ subroutine average_forcing(fluxes, dt, G, CS) endif call cpu_clock_end(id_clock_forcing) -end subroutine average_forcing +end subroutine forcing_diagnostics subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -1437,7 +1449,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) 'Surface friction velocity', 'meter second-1') if (CS%use_temperature) then - CS%id_PminusE = register_diag_field('ocean_model', 'PmE', diag%axesT1, Time, & + CS%id_pmepr = register_diag_field('ocean_model', 'PmEpR', diag%axesT1, Time, & 'Net fresh water flux (P-E+C+R)', 'kilogram meter-2 second-1') CS%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & 'Evaporation at ocean surface (usually negative)', 'kilogram meter-2 second-1') diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 3938204a93..1106923ae8 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -52,7 +52,7 @@ program MOM_main use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_file_parser, only : close_param_file - use MOM_forcing_type, only : forcing + use MOM_forcing_type, only : forcing, forcing_diagnostics use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, open_file, close_file @@ -61,7 +61,7 @@ program MOM_main use MOM_restart, only : save_restart use MOM_sum_output, only : write_energy, accumulate_net_input use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS - use MOM_surface_forcing, only : set_forcing, average_forcing, forcing_save_restart + use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS use MOM_time_manager, only : time_type, set_date, set_time, get_date, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) @@ -416,7 +416,7 @@ program MOM_main Time = Master_Time call enable_averaging(time_step,Time,MOM_CSp%diag) - call average_forcing(fluxes, time_step, grid, surface_forcing_CSp) + call forcing_diagnostics(fluxes, state, time_step, grid, MOM_CSp%diag, surface_forcing_CSp%handles) call accumulate_net_input(fluxes, state, time_step, grid, sum_output_CSp) call disable_averaging(MOM_CSp%diag) diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 3c6d8b44b2..424c68305c 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -67,13 +67,14 @@ module MOM_surface_forcing use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE use MOM_diag_mediator, only : post_data, query_averaging_enabled -use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID, To_South, To_West, To_All use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_string_functions, only : uppercase -use MOM_forcing_type, only : forcing, deallocate_forcing_type +use MOM_forcing_type, only : forcing, forcing_diags +use MOM_forcing_type, only : register_forcing_type_diags, deallocate_forcing_type use MOM_grid, only : ocean_grid_type use MOM_get_input, only : Get_MOM_Input, directories use MOM_io, only : file_exists, read_data, slasher, num_timelevels @@ -100,7 +101,7 @@ module MOM_surface_forcing #include -public set_forcing, surface_forcing_init, average_forcing, forcing_save_restart +public set_forcing, surface_forcing_init, forcing_save_restart type, public :: surface_forcing_CS ; private logical :: use_temperature ! If true, temperature and salinity are used as @@ -188,14 +189,8 @@ module MOM_surface_forcing integer :: evap_last_lev = -1, precip_last_lev = -1, runoff_last_lev = -1 integer :: SST_last_lev = -1, SSS_last_lev = -1 - integer :: id_taux = -1, id_tauy = -1, id_ustar = -1 - integer :: id_PminusE = -1, id_evap = -1, id_precip = -1 - integer :: id_liq_precip = -1, id_froz_precip = -1, id_virt_precip = -1 - integer :: id_liq_runoff = -1, id_froz_runoff = -1 - integer :: id_runoff_hflx = -1, id_calving_hflx = -1 - integer :: id_Net_Heating = -1, id_sw = -1, id_LwLatSens = -1, id_buoy = -1 - integer :: id_LW = -1, id_lat = -1, id_sens = -1 - integer :: id_psurf = -1, id_saltflux = -1, id_TKE_tidal = -1, id_heat_rest=-1 + ! Diagnostics handles + type(forcing_diags), public :: handles type(user_revise_forcing_CS), pointer :: urf_CS => NULL() type(user_surface_forcing_CS), pointer :: user_forcing_CSp => NULL() @@ -848,20 +843,33 @@ subroutine buoyancy_forcing_from_files(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(isd:ied,jsd:jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(isd:ied,jsd:jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the fresh water forcing by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. if (.not.associated(fluxes%sw)) then - allocate(fluxes%sw(isd:ied,jsd:jed)) ; fluxes%sw(:,:) = 0.0 + allocate(fluxes%sw(isd:ied,jsd:jed)) ; fluxes%sw(:,:) = 0.0 endif if (.not.associated(fluxes%lw)) then - allocate(fluxes%lw(isd:ied,jsd:jed)) ; fluxes%lw(:,:) = 0.0 + allocate(fluxes%lw(isd:ied,jsd:jed)) ; fluxes%lw(:,:) = 0.0 endif if (.not.associated(fluxes%latent)) then - allocate(fluxes%latent(isd:ied,jsd:jed)) ; fluxes%latent(:,:) = 0.0 + allocate(fluxes%latent(isd:ied,jsd:jed)) ; fluxes%latent(:,:) = 0.0 + endif + if (.not.associated(fluxes%latent_evap)) then + allocate(fluxes%latent_evap(isd:ied,jsd:jed)) ; fluxes%latent_evap(:,:) = 0.0 + endif + if (.not.associated(fluxes%latent_fprec)) then + allocate(fluxes%latent_fprec(isd:ied,jsd:jed)) ; fluxes%latent_fprec(:,:) = 0.0 + endif + if (.not.associated(fluxes%latent_calve)) then + allocate(fluxes%latent_calve(isd:ied,jsd:jed)) ; fluxes%latent_calve(:,:) = 0.0 endif if (.not.associated(fluxes%sens)) then - allocate(fluxes%sens(isd:ied,jsd:jed)) ; fluxes%sens(:,:) = 0.0 + allocate(fluxes%sens(isd:ied,jsd:jed)) ; fluxes%sens(:,:) = 0.0 endif if (CS%restorebuoy) then if (.not.associated(CS%T_Restore)) then @@ -934,8 +942,9 @@ subroutine buoyancy_forcing_from_files(state, fluxes, day, dt, G, CS) call read_data(CS%evaporation_file, CS%evap_var, temp(:,:), & domain=G%Domain%mpp_domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%latent(i,j) = -latent_heat_evap*temp(i,j) - fluxes%evap(i,j) = -temp(i,j) + fluxes%latent(i,j) = -latent_heat_evap*temp(i,j) + fluxes%latent_evap(i,j) = fluxes%latent(i,j) + fluxes%evap(i,j) = -temp(i,j) enddo ; enddo else call read_data(CS%evaporation_file, CS%evap_var, fluxes%evap(:,:), & @@ -951,6 +960,9 @@ subroutine buoyancy_forcing_from_files(state, fluxes, day, dt, G, CS) if (.not.CS%archaic_OMIP_file) then call read_data(CS%latentheat_file, CS%latent_var, fluxes%latent(:,:), & domain=G%Domain%mpp_domain, timelevel=time_lev) + do j=js,je ; do i=is,ie + fluxes%latent_evap(i,j) = fluxes%latent(i,j) + enddo ; enddo endif CS%latent_last_lev = time_lev @@ -1049,15 +1061,16 @@ subroutine buoyancy_forcing_from_files(state, fluxes, day, dt, G, CS) ! Mask out land points. do j=js,je ; do i=is,ie - fluxes%evap(i,j) = fluxes%evap(i,j) * G%mask2dT(i,j) + fluxes%evap(i,j) = fluxes%evap(i,j) * G%mask2dT(i,j) fluxes%liq_precip(i,j) = fluxes%liq_precip(i,j) * G%mask2dT(i,j) fluxes%froz_precip(i,j) = fluxes%froz_precip(i,j) * G%mask2dT(i,j) fluxes%liq_runoff(i,j) = fluxes%liq_runoff(i,j) * G%mask2dT(i,j) fluxes%froz_runoff(i,j) = fluxes%froz_runoff(i,j) * G%mask2dT(i,j) - fluxes%LW(i,j) = fluxes%LW(i,j) * G%mask2dT(i,j) - fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) - fluxes%sens(i,j) = fluxes%sens(i,j) * G%mask2dT(i,j) - fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) + fluxes%LW(i,j) = fluxes%LW(i,j) * G%mask2dT(i,j) + fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) + fluxes%latent_evap(i,j) = fluxes%latent_evap(i,j) * G%mask2dT(i,j) + fluxes%sens(i,j) = fluxes%sens(i,j) * G%mask2dT(i,j) + fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) enddo ; enddo endif ! time_lev /= CS%buoy_last_lev_read @@ -1199,6 +1212,10 @@ subroutine buoyancy_forcing_from_data_override(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(isd:ied,jsd:jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(isd:ied,jsd:jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the fresh water forcing by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. @@ -1211,6 +1228,9 @@ subroutine buoyancy_forcing_from_data_override(state, fluxes, day, dt, G, CS) if (.not.associated(fluxes%latent)) then allocate(fluxes%latent(isd:ied,jsd:jed)) ; fluxes%latent(:,:) = 0.0 endif + if (.not.associated(fluxes%latent_evap)) then + allocate(fluxes%latent_evap(isd:ied,jsd:jed)) ; fluxes%latent_evap(:,:) = 0.0 + endif if (.not.associated(fluxes%sens)) then allocate(fluxes%sens(isd:ied,jsd:jed)) ; fluxes%sens(:,:) = 0.0 endif @@ -1247,7 +1267,8 @@ subroutine buoyancy_forcing_from_data_override(state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie fluxes%evap(i,j) = -fluxes%evap(i,j) ! Normal convention is positive into the ocean ! but evap is normally a positive quantity in the files - fluxes%latent(i,j) = latent_heat_evap*fluxes%evap(i,j) + fluxes%latent(i,j) = latent_heat_evap*fluxes%evap(i,j) + fluxes%latent_evap(i,j) = fluxes%latent(i,j) enddo; enddo call data_override('OCN', 'sens', fluxes%sens(:,:), day, & @@ -1285,15 +1306,16 @@ subroutine buoyancy_forcing_from_data_override(state, fluxes, day, dt, G, CS) ! Mask out land points. do j=js,je ; do i=is,ie - fluxes%evap(i,j) = fluxes%evap(i,j) * G%mask2dT(i,j) + fluxes%evap(i,j) = fluxes%evap(i,j) * G%mask2dT(i,j) fluxes%liq_precip(i,j) = fluxes%liq_precip(i,j) * G%mask2dT(i,j) fluxes%froz_precip(i,j) = fluxes%froz_precip(i,j) * G%mask2dT(i,j) fluxes%liq_runoff(i,j) = fluxes%liq_runoff(i,j) * G%mask2dT(i,j) fluxes%froz_runoff(i,j) = fluxes%froz_runoff(i,j) * G%mask2dT(i,j) - fluxes%LW(i,j) = fluxes%LW(i,j) * G%mask2dT(i,j) - fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) - fluxes%sens(i,j) = fluxes%sens(i,j) * G%mask2dT(i,j) - fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) + fluxes%LW(i,j) = fluxes%LW(i,j) * G%mask2dT(i,j) + fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) + fluxes%latent_evap(i,j) = fluxes%latent_evap(i,j) * G%mask2dT(i,j) + fluxes%sens(i,j) = fluxes%sens(i,j) * G%mask2dT(i,j) + fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) enddo; enddo @@ -1397,6 +1419,10 @@ subroutine buoyancy_forcing_zero(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(G%isd:G%ied,G%jsd:G%jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(G%isd:G%ied,G%jsd:G%jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the heat fluxes by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. @@ -1409,6 +1435,9 @@ subroutine buoyancy_forcing_zero(state, fluxes, day, dt, G, CS) if (.not.associated(fluxes%latent)) then allocate(fluxes%latent(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%latent(:,:) = 0.0 endif + if (.not.associated(fluxes%latent_evap)) then + allocate(fluxes%latent_evap(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%latent_evap(:,:) = 0.0 + endif if (.not.associated(fluxes%sens)) then allocate(fluxes%sens(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%sens(:,:) = 0.0 endif @@ -1422,10 +1451,11 @@ subroutine buoyancy_forcing_zero(state, fluxes, day, dt, G, CS) if (CS%use_temperature) then do j=js,je ; do i=is,ie - fluxes%sw(i,j) = 0.0 - fluxes%lw(i,j) = 0.0 - fluxes%latent(i,j) = 0.0 - fluxes%sens(i,j) = 0.0 + fluxes%sw(i,j) = 0.0 + fluxes%lw(i,j) = 0.0 + fluxes%latent(i,j) = 0.0 + fluxes%latent_evap(i,j)= 0.0 + fluxes%sens(i,j) = 0.0 fluxes%liq_precip(i,j) = 0.0 enddo ; enddo else @@ -1488,6 +1518,10 @@ subroutine buoyancy_forcing_const(state, fluxes, day, dt, G, CS) allocate(fluxes%virt_precip(G%isd:G%ied,G%jsd:G%jed)) fluxes%virt_precip(:,:) = 0.0 endif + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(G%isd:G%ied,G%jsd:G%jed)) + fluxes%seaice_melt(:,:) = 0.0 + endif ! Specify the heat fluxes by setting the following, all in units ! of W m-2 and positive for heat fluxes into the ocean. @@ -1500,6 +1534,9 @@ subroutine buoyancy_forcing_const(state, fluxes, day, dt, G, CS) if (.not.associated(fluxes%latent)) then allocate(fluxes%latent(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%latent(:,:) = 0.0 endif + if (.not.associated(fluxes%latent_evap)) then + allocate(fluxes%latent_evap(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%latent_evap(:,:) = 0.0 + endif if (.not.associated(fluxes%sens)) then allocate(fluxes%sens(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%sens(:,:) = CS%constantHeatForcing endif @@ -1565,9 +1602,9 @@ subroutine buoyancy_forcing_linear(state, fluxes, day, dt, G, CS) allocate(fluxes%froz_runoff(G%isd:G%ied,G%jsd:G%jed)) fluxes%froz_runoff(:,:) = 0.0 endif - if (.not.associated(fluxes%virt_precip)) then - allocate(fluxes%virt_precip(G%isd:G%ied,G%jsd:G%jed)) - fluxes%virt_precip(:,:) = 0.0 + if (.not.associated(fluxes%seaice_melt)) then + allocate(fluxes%seaice_melt(G%isd:G%ied,G%jsd:G%jed)) + fluxes%seaice_melt(:,:) = 0.0 endif ! Specify the heat fluxes by setting the following, all in units @@ -1581,11 +1618,19 @@ subroutine buoyancy_forcing_linear(state, fluxes, day, dt, G, CS) if (.not.associated(fluxes%latent)) then allocate(fluxes%latent(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%latent(:,:) = 0.0 endif + if (.not.associated(fluxes%latent_evap)) then + allocate(fluxes%latent_evap(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%latent_evap(:,:) = 0.0 + endif if (.not.associated(fluxes%sens)) then allocate(fluxes%sens(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%sens(:,:) = 0.0 endif - if (.not.associated(fluxes%heat_restore)) then - allocate(fluxes%heat_restore(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%heat_restore(:,:) = 0.0 + if (CS%restorebuoy) then + if (.not.associated(fluxes%heat_restore)) then + allocate(fluxes%heat_restore(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%heat_restore(:,:) = 0.0 + endif + if (.not.associated(fluxes%virt_precip)) then + allocate(fluxes%virt_precip(G%isd:G%ied,G%jsd:G%jed)) ; fluxes%virt_precip(:,:) = 0.0 + endif endif else if (.not.associated(fluxes%buoy)) then @@ -1596,11 +1641,12 @@ subroutine buoyancy_forcing_linear(state, fluxes, day, dt, G, CS) ! This case has no surface buoyancy forcing. if (CS%use_temperature) then do j=js,je ; do i=is,ie - fluxes%sw(i,j) = 0.0 - fluxes%lw(i,j) = 0.0 - fluxes%latent(i,j) = 0.0 - fluxes%sens(i,j) = 0.0 - fluxes%liq_precip(i,j) = 0.0 + fluxes%sw(i,j) = 0.0 + fluxes%lw(i,j) = 0.0 + fluxes%latent(i,j) = 0.0 + fluxes%latent_evap(i,j) = 0.0 + fluxes%sens(i,j) = 0.0 + fluxes%liq_precip(i,j) = 0.0 enddo ; enddo else do j=js,je ; do i=is,ie @@ -1651,109 +1697,6 @@ subroutine buoyancy_forcing_linear(state, fluxes, day, dt, G, CS) end subroutine buoyancy_forcing_linear -subroutine average_forcing(fluxes, dt, G, CS) - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt - type(ocean_grid_type), intent(in) :: G - type(surface_forcing_CS), pointer :: CS -! This subroutine offers forcing fields for time averaging. These -! fields must first be registered in surface_forcing_init (below). -! This subroutine will typically not be modified, except when new -! forcing fields are added. -! -! Arguments: fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields are unallocated. -! (in) dt - The amount of time over which to average. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. - integer :: i,j - real, dimension(SZI_(G),SZJ_(G)) :: sum - - call cpu_clock_begin(id_clock_forcing) - - if (query_averaging_enabled(CS%diag)) then - if ((CS%id_taux > 0) .and. ASSOCIATED(fluxes%taux)) & - call post_data(CS%id_taux, fluxes%taux, CS%diag) - if ((CS%id_tauy > 0) .and. ASSOCIATED(fluxes%tauy)) & - call post_data(CS%id_tauy, fluxes%tauy, CS%diag) - if ((CS%id_ustar > 0) .and. ASSOCIATED(fluxes%ustar)) & - call post_data(CS%id_ustar, fluxes%ustar, CS%diag) - - if (CS%id_PminusE > 0) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:)+fluxes%liq_precip(:,:) - if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:)+fluxes%froz_precip(:,:) - if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:)+fluxes%evap(:,:) - if (ASSOCIATED(fluxes%liq_runoff)) sum(:,:) = sum(:,:)+fluxes%liq_runoff(:,:) - if (ASSOCIATED(fluxes%froz_runoff)) sum(:,:) = sum(:,:)+fluxes%froz_runoff(:,:) - if (ASSOCIATED(fluxes%virt_precip)) sum(:,:) = sum(:,:)+fluxes%virt_precip(:,:) - call post_data(CS%id_PminusE, sum, CS%diag) - endif - - if ((CS%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & - call post_data(CS%id_evap, fluxes%evap, CS%diag) - if ((CS%id_precip > 0) .and. ASSOCIATED(fluxes%liq_precip) & - .and. ASSOCIATED(fluxes%froz_precip)) then - sum(:,:) = fluxes%liq_precip(:,:) + fluxes%froz_precip(:,:) - call post_data(CS%id_precip, sum, CS%diag) - endif - - if ((CS%id_liq_precip > 0) .and. ASSOCIATED(fluxes%liq_precip)) & - call post_data(CS%id_liq_precip, fluxes%liq_precip, CS%diag) - if ((CS%id_froz_precip > 0) .and. ASSOCIATED(fluxes%froz_precip)) & - call post_data(CS%id_froz_precip, fluxes%froz_precip, CS%diag) - if ((CS%id_virt_precip > 0) .and. ASSOCIATED(fluxes%virt_precip)) & - call post_data(CS%id_virt_precip, fluxes%virt_precip, CS%diag) - if ((CS%id_liq_runoff > 0) .and. ASSOCIATED(fluxes%liq_runoff)) & - call post_data(CS%id_liq_runoff, fluxes%liq_runoff, CS%diag) - if ((CS%id_froz_runoff > 0) .and. ASSOCIATED(fluxes%froz_runoff)) & - call post_data(CS%id_froz_runoff, fluxes%froz_runoff, CS%diag) - - if ((CS%id_runoff_hflx > 0) .and. ASSOCIATED(fluxes%runoff_hflx)) & - call post_data(CS%id_runoff_hflx, fluxes%runoff_hflx, CS%diag) - if ((CS%id_calving_hflx > 0) .and. ASSOCIATED(fluxes%calving_hflx)) & - call post_data(CS%id_calving_hflx, fluxes%calving_hflx, CS%diag) - - if (CS%id_Net_Heating > 0) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%LW)) sum(:,:) = sum(:,:) + fluxes%LW(:,:) - if (ASSOCIATED(fluxes%latent)) sum(:,:) = sum(:,:) + fluxes%latent(:,:) - if (ASSOCIATED(fluxes%sens)) sum(:,:) = sum(:,:) + fluxes%sens(:,:) - if (ASSOCIATED(fluxes%SW)) sum(:,:) = sum(:,:) + fluxes%SW(:,:) - call post_data(CS%id_Net_Heating, sum, CS%diag) - endif - if ((CS%id_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & - ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then - sum(:,:) = (fluxes%lw(:,:) + fluxes%latent(:,:)) + fluxes%sens(:,:) - call post_data(CS%id_LwLatSens, sum, CS%diag) - endif - - if ((CS%id_sw > 0) .and. ASSOCIATED(fluxes%sw)) & - call post_data(CS%id_sw, fluxes%sw, CS%diag) - if ((CS%id_LW > 0) .and. ASSOCIATED(fluxes%lw)) & - call post_data(CS%id_LW, fluxes%lw, CS%diag) - if ((CS%id_lat > 0) .and. ASSOCIATED(fluxes%latent)) & - call post_data(CS%id_lat, fluxes%latent, CS%diag) - if ((CS%id_sens > 0) .and. ASSOCIATED(fluxes%sens)) & - call post_data(CS%id_sens, fluxes%sens, CS%diag) - if ((CS%id_heat_rest > 0) .and. ASSOCIATED(fluxes%heat_restore)) & - call post_data(CS%id_heat_rest, fluxes%heat_restore, CS%diag) - - if ((CS%id_psurf > 0) .and. ASSOCIATED(fluxes%p_surf)) & - call post_data(CS%id_psurf, fluxes%p_surf, CS%diag) - if ((CS%id_saltflux > 0) .and. ASSOCIATED(fluxes%salt_flux)) & - call post_data(CS%id_saltflux, fluxes%salt_flux, CS%diag) - if ((CS%id_TKE_tidal > 0) .and. ASSOCIATED(fluxes%TKE_tidal)) & - call post_data(CS%id_TKE_tidal, fluxes%TKE_tidal, CS%diag) - - if ((CS%id_buoy > 0) .and. ASSOCIATED(fluxes%buoy)) & - call post_data(CS%id_buoy, fluxes%buoy, CS%diag) - endif - - call cpu_clock_end(id_clock_forcing) -end subroutine average_forcing - subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) type(surface_forcing_CS), pointer :: CS @@ -2101,61 +2044,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) endif - CS%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, Time, & - 'Zonal Wind Stress', 'Pascal') - CS%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & - 'Meridional Wind Stress', 'Pascal') - CS%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & - 'Surface friction velocity', 'meter second-1') - - if (CS%use_temperature) then - CS%id_PminusE = register_diag_field('ocean_model', 'PmE', diag%axesT1, Time, & - 'Net fresh water flux (P-E+C+R)', 'kilogram meter-2 second-1') - CS%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & - 'Evaporation at ocean surface (usually negative)', 'kilogram meter-2 second-1') - CS%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & - 'Net (liq.+froz.) precipitation into ocean', 'kilogram meter-2 second-1') - CS%id_froz_precip = register_diag_field('ocean_model', 'froz_precip', diag%axesT1, Time, & - 'Frozen Precipitation into ocean', 'kilogram meter-2 second-1') - CS%id_liq_precip = register_diag_field('ocean_model', 'liq_precip', diag%axesT1, Time, & - 'Liquid Precipitation into ocean', 'kilogram meter-2 second-1') - CS%id_virt_precip = register_diag_field('ocean_model', 'virt_precip', diag%axesT1, Time, & - 'Virtual Precipitation due to salt restoring', 'kilogram meter-2 second-1') - CS%id_froz_runoff = register_diag_field('ocean_model', 'froz_runoff', diag%axesT1, Time, & - 'Frozen runoff (calving) into ocean', 'kilogram meter-2 second-1') - CS%id_liq_runoff = register_diag_field('ocean_model', 'liq_runoff', diag%axesT1, Time, & - 'Liquid runoff (rivers) into ocean', 'kilogram meter-2 second-1') - CS%id_runoff_hflx = register_diag_field('ocean_model', 'runoff_hflx', diag%axesT1, Time, & - 'Heat content of liquid runoff (rivers) into ocean', 'Watt meter-2') - CS%id_calving_hflx = register_diag_field('ocean_model', 'calving_hflx', diag%axesT1, Time, & - 'Heat content of liquid runoff (rivers) into ocean', 'Watt meter-2') - - CS%id_Net_Heating = register_diag_field('ocean_model', 'Net_Heat', diag%axesT1, Time, & - 'Net Surface Heating of Ocean', 'Watt meter-2') - CS%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, Time, & - 'Shortwave radiation flux into ocean', 'Watt meter-2') - CS%id_LwLatSens = register_diag_field('ocean_model', 'LwLatSens', diag%axesT1, Time, & - 'Combined longwave, latent, and sensible heating', 'Watt meter-2') - CS%id_lw = register_diag_field('ocean_model', 'LW', diag%axesT1, Time, & - 'Longwave radiation flux into ocean', 'Watt meter-2') - CS%id_lat = register_diag_field('ocean_model', 'latent', diag%axesT1, Time, & - 'Latent heat flux into ocean', 'Watt meter-2') - CS%id_sens = register_diag_field('ocean_model', 'sensible', diag%axesT1, Time, & - 'Sensible heat flux into ocean', 'Watt meter-2') - if (CS%restorebuoy) & - CS%id_heat_rest = register_diag_field('ocean_model', 'heat_rest', diag%axesT1, Time, & - 'Restoring surface heat flux into ocean', 'Watt meter-2') - - CS%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, Time, & - 'Pressure at ice-ocean or atmosphere-ocean interface', 'Pascal') - CS%id_saltflux = register_diag_field('ocean_model', 'salt_flux', diag%axesT1, Time, & - 'Salt flux into ocean at surface', 'kilogram meter-2 second-1') - CS%id_TKE_tidal = register_diag_field('ocean_model', 'TKE_tidal', diag%axesT1, Time, & - 'Tidal source of BBL mixing', 'Watt meter-2') - else - CS%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, Time, & - 'Buoyancy forcing', 'meter2 second-3') - endif + call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles) ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ea3d81133a..42acd839ba 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -29,7 +29,8 @@ module MOM !* With software contributions from: * !* Whit Anderson, Brian Arbic, Will Cooke, Anand Gnanadesikan, * !* Matthew Harrison, Mehmet Ilicak, Laura Jackson, Jasmine John, * -!* Bonnie Samuels, Harper Simmons, Laurent White and Niki Zadeh * +!* John Krasting, Bonnie Samuels, Harper Simmons, Laurent White * +!* Zhi Liang, and Niki Zadeh * !* * !* MOM ice-shelf code by Daniel Goldberg, Robert Hallberg * !* Chris Little, and Olga Sergienko * @@ -59,7 +60,7 @@ module MOM !* Layered Dynamics (GOLD) ocean model, which was also primarily * !* developed at NOAA/GFDL. MOM has also benefited tremendously from * !* the FMS infrastructure, which it utilizes and shares with other * -!* component models developed at GFDL. * +!* component models developed at NOAA/GFDL. * !* * !* When run is isopycnal-coordinate mode, the uppermost few layers * !* are often used to describe a bulk mixed layer, including the * @@ -238,8 +239,8 @@ module MOM !* These files provide infrastructure utilities for MOM. Many are * !* simply wrappers for capabilities provided by FMS, although others* !* provide capabilities (like the file_parser) that are unique to * -!* MOM. When MOM is adapted to use a different modeling * -!* infrastructure, most of the required changes are in this * +!* MOM. When MOM is adapted to use a modeling infrastructure * +!* distinct from FMS, most of the required changes are in this * !* directory. * !* src/initialization: * !* These are the files that are used to initialize the MOM grid * @@ -281,9 +282,10 @@ module MOM !* step_MOM steps MOM over a specified interval of time. * !* MOM_initialize calls initialize and does other initialization * !* that does not warrant user modification. * -!* calculate_surface_state determines the surface (mixed layer) * -!* properties of the current model state and packages pointers * -!* to these fields into an exported structure. * +!* calculate_surface_state determines the surface (bulk mixed layer * +!* if traditional isoycnal vertical coordinate) properties of the * +!* current model state and packages pointers to these fields into an * +!* exported structure. * !* * !* The remaining subroutines in this file (src/core/MOM.F90) are: * !* find_total_transport determines the barotropic mass transport. * @@ -2006,7 +2008,7 @@ subroutine register_diags(Time, G, CS, ADp) !call diag_masks_set(G, CS%missing) CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & - 'Zonal velocity', 'meter second-1') + 'Zonal velocity', 'meter second-1') CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & 'Meridional velocity', 'meter second-1') CS%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index d78bddc083..357cbd5474 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -21,14 +21,14 @@ module MOM_forcing_type use MOM_checksums, only : hchksum, qchksum, uchksum, vchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc -use MOM_diag_mediator, only : time_type +use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field +use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_EOS, only : calculate_density_derivs use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs +use MOM_variables, only : surface, thermo_var_ptrs use coupler_types_mod, only : coupler_2d_bc_type @@ -43,6 +43,8 @@ module MOM_forcing_type public calculateBuoyancyFlux1d public calculateBuoyancyFlux2d public forcing_SinglePointPrint +public forcing_diagnostics +public register_forcing_type_diags public deallocate_forcing_type integer :: num_msg = 0 @@ -50,10 +52,16 @@ module MOM_forcing_type type, public :: forcing - ! This structure contains pointers to the boundary - ! forcing used to drive the liquid ocean as part of MOM. - ! All fluxes are positive downward (into the ocean). - ! Pointers to unused fluxes should be set to NULL. + ! This structure contains pointers to the boundary + ! forcing used to drive the liquid ocean as part of MOM. + ! All fluxes are positive into the ocean. For surface + ! fluxes, that means fluxes are positive downward. + ! + ! Pointers to unused fluxes should be set to NULL. + ! + ! The data in this type is allocated from the module + ! MOM_surface_forcing.F90, of which there are three + ! version:, solo, coupled and ice-shelf. real, pointer, dimension(:,:) :: & @@ -66,21 +74,24 @@ module MOM_forcing_type buoy => NULL(), & ! buoyancy flux (m2/s3) ! radiative heat fluxes into the ocean (W/m2) - sw => NULL(), & ! shortwave heat flux (W/m2) - sw_vis_dir => NULL(), & ! visible, direct shortwave heat flux (W/m2) - sw_vis_dif => NULL(), & ! visible, diffuse shortwave heat flux (W/m2) - sw_nir_dir => NULL(), & ! near-IR, direct shortwave heat flux (W/m2) - sw_nir_dif => NULL(), & ! near-IR, diffuse shortwave heat flux (W/m2) - lw => NULL(), & ! longwave heat flux (W/m2) (typically negative) + sw => NULL(), & ! shortwave (W/m2) + sw_vis_dir => NULL(), & ! visible, direct shortwave (W/m2) + sw_vis_dif => NULL(), & ! visible, diffuse shortwave (W/m2) + sw_nir_dir => NULL(), & ! near-IR, direct shortwave (W/m2) + sw_nir_dif => NULL(), & ! near-IR, diffuse shortwave (W/m2) + lw => NULL(), & ! longwave (W/m2) (typically negative) ! turbulent heat fluxes into the ocean (W/m2) - latent => NULL(), & ! latent heat flux (W/m2) (typically negative) - sens => NULL(), & ! sensible heat flux (W/m2) (typically negative) + latent => NULL(), & ! latent (W/m2) (typically negative) + latent_evap => NULL(), & ! latent (W/m2) due to evaporating liquid water (typically negative) + latent_fprec => NULL(), & ! latent (W/m2) due to melting frozen precip (typically negative) + latent_calve => NULL(), & ! latent (W/m2) due to melting frozen calved land ice (typically negative) + sens => NULL(), & ! sensible (W/m2) (typically negative) heat_restore => NULL(), & ! heat flux from SST restoring (W/m2) in idealized simulations - ! sensible heat associated with runoff and calving - runoff_hflx => NULL(), & ! heat flux associated with liq_runoff (W/m2) - calving_hflx => NULL(), & ! heat flux associated with froz_runoff (W/m2) + ! heat associated with runoff and calving + runoff_heat_content => NULL(), & ! heat content associated with liq_runoff (W/m2) + calving_heat_content => NULL(), & ! heat content associated with froz_runoff (W/m2) ! water mass fluxes into the ocean ( kg/(m2 s) ) ! these mass fluxes impact the ocean mass @@ -90,9 +101,12 @@ module MOM_forcing_type virt_precip => NULL(), & ! virtual water associated w/ SSS restoring ( kg/(m2 s) ) liq_runoff => NULL(), & ! liquid river runoff ( kg/(m2 s) ) froz_runoff => NULL(), & ! calving land ice ( kg/(m2 s) ) + seaice_melt => NULL(), & ! seaice melt (positive flux) or formation (negative flux) ( kg/(m2 s) ) - ! salt mass flux (does not contribute to ocean mass) - salt_flux => NULL(), & ! net salt flux into the ocean ( kg salt/(m2 s) ) + ! salt mass flux (contributes to ocean mass only if non-Bouss ) + salt_flux => NULL(), & ! net salt flux into the ocean ( kg salt/(m2 s) ) + salt_flux_in => NULL(), & ! salt flux provided to the ocean from coupler ( kg salt/(m2 s) ) + salt_flux_restore => NULL(), & ! restoring component of salt flux before adjustment to net zero ( kg salt/(m2 s) ) ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) p_surf_full => NULL(), & ! pressure at the top ocean interface (Pa). @@ -115,6 +129,9 @@ module MOM_forcing_type rigidity_ice_u => NULL(),& ! Depth-integrated lateral viscosity of rigidity_ice_v => NULL() ! ice shelves at u- or v-points (m3/s) + ! Scalars set by surface forcing modules + real :: Sflux_adj_total ! adjustment to restoring salt flux to zero out global net ( kg salt/(m2 s) ) + ! heat capacity real :: C_p ! heat capacity of seawater ( J/(K kg) ) ! C_p is is the same value as in thermovar_ptrs_type. @@ -127,9 +144,44 @@ module MOM_forcing_type end type forcing +type, public :: forcing_diags + ! id handles for the forcing type + + ! diagnostic manager id handles + integer :: id_prcme = -1, id_evap = -1 + integer :: id_precip = -1, id_virt_precip = -1 + integer :: id_liq_precip = -1, id_froz_precip = -1 + integer :: id_liq_runoff = -1, id_froz_runoff = -1 + integer :: id_seaice_melt = -1 + + integer :: id_net_heat_coupler = -1, id_net_heat_surface = -1 + integer :: id_sens = -1, id_LwLatSens = -1 + integer :: id_sw = -1, id_LW = -1 + integer :: id_lat_evap = -1, id_lat_calve = -1 + integer :: id_lat = -1, id_lat_fprec = -1 + integer :: id_runoff_heat_content = -1, id_calving_heat_content = -1 + integer :: id_precip_heat_content = -1, id_evap_heat_content = -1 + integer :: id_heat_rest = -1 + + integer :: id_saltflux = -1, id_saltFluxIn = -1 + integer :: id_saltFluxRestore = -1, id_saltFluxGlobalAdj = -1 + + integer :: id_taux = -1, id_tauy = -1 + integer :: id_ustar = -1 + + integer :: id_psurf = -1 + integer :: id_TKE_tidal = -1 + integer :: id_buoy = -1 + + + ! clock id handle + integer :: id_clock_forcing + +end type forcing_diags + type, public :: optics_type - ! Type for ocean optical properties + ! ocean optical properties integer :: nbands ! number of penetrating bands of SW radiation @@ -149,18 +201,18 @@ module MOM_forcing_type end type optics_type - contains +!> Extract fluxes from surface fluxes type. subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, & DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & - h, T, Net_H, Net_heat, Net_salt, Pen_SW_bnd, tv) + h, T, net_H, net_heat, net_salt, pen_SW_bnd, tv) ! This subroutine extracts fluxes from the surface fluxes type. It works on a j-row -! for optimization purposes. The 2d i,j wrapper is the next subroutine below. +! for optimization purposes. The 2d (i,j) wrapper is the next subroutine below. type(ocean_grid_type), intent(in) :: G - type(forcing), intent(in) :: fluxes + type(forcing), intent(in) :: fluxes type(optics_type), pointer :: optics integer, intent(in) :: nsw integer, intent(in) :: j @@ -170,10 +222,10 @@ subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, logical, intent(in) :: useCalvingHeatContent real, dimension(NIMEM_,NKMEM_), intent(in) :: h real, dimension(NIMEM_,NKMEM_), intent(in) :: T - real, dimension(NIMEM_), intent(out) :: Net_H - real, dimension(NIMEM_), intent(out) :: Net_heat - real, dimension(NIMEM_), intent(out) :: Net_salt - real, dimension(:,:), intent(out) :: Pen_SW_bnd + real, dimension(NIMEM_), intent(out) :: net_H + real, dimension(NIMEM_), intent(out) :: net_heat + real, dimension(NIMEM_), intent(out) :: net_salt + real, dimension(:,:), intent(out) :: pen_SW_bnd type(thermo_var_ptrs), intent(inout) :: tv ! (in) G = ocean grid structure @@ -188,16 +240,17 @@ subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, ! (in) h = layer thickness, in m for Bouss or (kg/m2) for non-Bouss ! (in) T = layer temperatures, in deg C -! (out) Net_H = net mass flux (if non-Boussinesq) or volume flux (if Boussinesq) -! i.e. fresh water flux (P+R-E) into ocean over a time step (units of H) -! (out) Net_heat = net heating at the surface over a time step, -! exclusive of heating that appears in Pen_SW (K * H) -! (out) Net_salt = surface salt flux into the ocean over a time step (psu * H) -! (out) Pen_SW_bnd = penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x NIMEM_. -! (inout) tv = structure containing pointers to any available -! thermodynamic fields. Here it is used to keep track of the -! heat flux associated with net mass fluxes into the ocean. +! (out) net_H = net mass flux (if non-Boussinesq) or volume flux (if Boussinesq) +! i.e. fresh water flux (P+R-E) into ocean over a time step (units of H) +! (out) net_heat = net heating at the surface over a time step associated with coupler +! and restoring; i.e., net_heat=SW+LW+Latent+Sensible+river (K * H). +! This term misses the heat from precip-evap. +! (out) net_salt = surface salt flux into the ocean over a time step (psu * H) +! (out) pen_SW_bnd = penetrating shortwave heating at the sea surface +! in each penetrating band, in K H, size nsw x NIMEM_. +! (inout) tv = structure containing pointers to any available +! thermodynamic fields. Here it is used to keep track of the +! heat flux associated with net mass fluxes into the ocean. real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m2 for non-Bouss) real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW (K * H) @@ -246,13 +299,13 @@ subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, "MOM_forcing_type extractFluxes1d: No precipitation defined in mixedlayer.") if (useRiverHeatContent .and. & - .not.ASSOCIATED(fluxes%runoff_hflx)) call MOM_error(FATAL, & - "MOM_forcing_type extractFluxes1d: fluxes%runoff_hflx must be "//& + .not.ASSOCIATED(fluxes%runoff_heat_content)) call MOM_error(FATAL, & + "MOM_forcing_type extractFluxes1d: fluxes%runoff_heat_content must be "//& "assocated if USE_RIVER_HEAT_CONTENT is true.") if (useCalvingHeatContent .and. & - .not.ASSOCIATED(fluxes%calving_hflx)) call MOM_error(FATAL, & - "MOM_forcing_type extractFluxes1d: fluxes%calving_hflx must be "//& + .not.ASSOCIATED(fluxes%calving_heat_content)) call MOM_error(FATAL, & + "MOM_forcing_type extractFluxes1d: fluxes%calving_heat_content must be "//& "assocated if USE_CALVING_HEAT_CONTENT is true.") do i=is,ie ; htot(i) = h(i,1) ; enddo @@ -274,46 +327,45 @@ subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, else Pen_SW_bnd(1,i) = 0.0 endif - + ! Volume/mass fluxes - Net_H(i) = dt * (scale * ((((( fluxes%liq_precip(i,j) & + net_H(i) = dt * (scale * ((((( fluxes%liq_precip(i,j) & + fluxes%froz_precip(i,j) ) & + fluxes%evap(i,j) ) & + fluxes%liq_runoff(i,j) ) & + fluxes%virt_precip(i,j) ) & + fluxes%froz_runoff(i,j) ) ) - Net_H(i) = G%kg_m2_to_H * Net_H(i) + net_H(i) = G%kg_m2_to_H * net_H(i) - ! for non-Bouss, we add salt mass to total ocean mass - ! smg: is there salt mass loss from ice model? + ! for non-Bouss, we add salt mass to total ocean mass. to conserve + ! total salt mass ocean+ice, the sea ice model must lose mass when + ! salt mass is added to the ocean. if (.not.G%Boussinesq .and. ASSOCIATED(fluxes%salt_flux)) & - Net_H(i) = Net_H(i) + (dt * G%kg_m2_to_H) * (scale * fluxes%salt_flux(i,j)) + net_H(i) = net_H(i) + (dt * G%kg_m2_to_H) * (scale * fluxes%salt_flux(i,j)) ! Heat fluxes - Net_heat(i) = scale * dt * Irho_cp * ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) + net_heat(i) = scale * dt * Irho_cp * ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) - if (ASSOCIATED(fluxes%heat_restore)) Net_heat(i) = Net_heat(i) + (scale * (dt * Irho_cp)) * fluxes%heat_restore(i,j) + if (ASSOCIATED(fluxes%heat_restore)) net_heat(i) = net_heat(i) + (scale * (dt * Irho_cp)) * fluxes%heat_restore(i,j) if (useRiverHeatContent) then ! remove liq_runoff*SST here, to counteract its addition elsewhere - ! smg: this is awkward; needs to be cleaned up. - Net_heat(i) = (Net_heat(i) + (scale*(dt*Irho_cp)) * fluxes%runoff_hflx(i,j)) - & + net_heat(i) = (net_heat(i) + (scale*(dt*Irho_cp)) * fluxes%runoff_heat_content(i,j)) - & (G%kg_m2_to_H * (scale * dt)) * fluxes%liq_runoff(i,j) * T(i,1) if (ASSOCIATED(tv%TempxPmE)) then tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & - (I_Cp*fluxes%runoff_hflx(i,j) - fluxes%liq_runoff(i,j)*T(i,1)) + (I_Cp*fluxes%runoff_heat_content(i,j) - fluxes%liq_runoff(i,j)*T(i,1)) endif endif if (useCalvingHeatContent) then ! remove liq_runoff*SST here, to counteract its addition elsewhere - ! smg: this is awkward; needs to be cleaned up. - Net_heat(i) = Net_heat(i) + (scale*(dt*Irho_cp)) * fluxes%calving_hflx(i,j) - & + net_heat(i) = net_heat(i) + (scale*(dt*Irho_cp)) * fluxes%calving_heat_content(i,j) - & (G%kg_m2_to_H * (scale * dt)) * fluxes%froz_runoff(i,j) * T(i,1) if (ASSOCIATED(tv%TempxPmE)) then tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & - (I_Cp*fluxes%calving_hflx(i,j) - fluxes%froz_runoff(i,j)*T(i,1)) + (I_Cp*fluxes%calving_heat_content(i,j) - fluxes%froz_runoff(i,j)*T(i,1)) endif endif @@ -329,11 +381,12 @@ subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, endif endif - Net_heat(i) = Net_heat(i) - Pen_SW_tot(i) + net_heat(i) = net_heat(i) - Pen_SW_tot(i) + ! Salt fluxes Net_salt(i) = 0.0 - ! Convert salt_flux from kg (salt) m-2 s-1 to PSU m s-1. + ! Convert salt_flux from kg (salt) / (m2 s) to (ppt m/s). if (ASSOCIATED(fluxes%salt_flux)) & Net_salt(i) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * G%kg_m2_to_H @@ -342,12 +395,13 @@ subroutine extractFluxes1d(G, fluxes, optics, nsw, j, dt, end subroutine extractFluxes1d +!> 2d wrapper for 1d extract fluxes from surface fluxes type. subroutine extractFluxes2d(G, fluxes, optics, nsw, dt, & DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & - h, T, Net_H, Net_heat, Net_salt, Pen_SW_bnd, tv) + h, T, net_H, net_heat, Net_salt, Pen_SW_bnd, tv) -! This subroutine extracts fluxes from the surface fluxes type. It is a -! wrapper for the 1d routine extractFluxes1d. + ! This subroutine extracts fluxes from the surface fluxes type. It is a + ! wrapper for the 1d routine extractFluxes1d. type(ocean_grid_type), intent(in) :: G type(forcing), intent(in) :: fluxes @@ -359,12 +413,13 @@ subroutine extractFluxes2d(G, fluxes, optics, nsw, dt, logical, intent(in) :: useCalvingHeatContent real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: T - real, dimension(NIMEM_,NJMEM_), intent(out) :: Net_H - real, dimension(NIMEM_,NJMEM_), intent(out) :: Net_heat - real, dimension(NIMEM_,NJMEM_), intent(out) :: Net_salt - real, dimension(:,:,:), intent(out) :: Pen_SW_bnd + real, dimension(NIMEM_,NJMEM_), intent(out) :: net_H + real, dimension(NIMEM_,NJMEM_), intent(out) :: net_heat + real, dimension(NIMEM_,NJMEM_), intent(out) :: net_salt + real, dimension(:,:,:), intent(out) :: pen_SW_bnd type(thermo_var_ptrs), intent(inout) :: tv + ! (in) G = ocean grid structure ! (in) fluxes = structure containing pointers to possible ! forcing fields. Unused fields have NULL ptrs. @@ -376,31 +431,34 @@ subroutine extractFluxes2d(G, fluxes, optics, nsw, dt, ! (in) h = layer thickness, in m for Bouss or (kg/m2) for non-Bouss ! (in) T = layer temperatures, in deg C -! (out) Net_H = net mass flux (if non-Boussinesq) or volume flux (if Boussinesq) +! (out) net_H = net mass flux (if non-Boussinesq) or volume flux (if Boussinesq) ! i.e. fresh water flux (P+R-E) into ocean over a time step (units of H) -! (out) Net_heat = net heating at the surface over a time step, -! exclusive of heating that appears in Pen_SW (K * H) -! (out) Net_salt = surface salt flux into the ocean over a time step (psu * H) -! (out) Pen_SW_bnd = penetrating shortwave heating at the sea surface +! (out) net_heat = net heating at the surface over a time step associated with coupler +! and restoring; i.e., net_heat=SW+LW+Latent+Sensible+river (K * H). +! This term misses the heat from precip-evap. +! (out) net_salt = surface salt flux into the ocean over a time step (psu * H) +! (out) pen_SW_bnd = penetrating shortwave heating at the sea surface ! in each penetrating band, in K H, size nsw x NIMEM_. ! (inout) tv = structure containing pointers to any available ! thermodynamic fields. Here it is used to keep track of the ! heat flux associated with net mass fluxes into the ocean. integer :: j - do j=G%jsc, G%jec + do j=G%jsc, G%jec call extractFluxes1d(G, fluxes, optics, nsw, j, dt, & DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & - h(:,j,:), T(:,j,:), Net_H(:,j), Net_heat(:,j), Net_salt(:,j), Pen_SW_bnd(:,:,j), tv) + h(:,j,:), T(:,j,:), net_H(:,j), net_heat(:,j), net_salt(:,j), & + pen_SW_bnd(:,:,j), tv) enddo end subroutine extractFluxes2d +!> Compute surface buoyancy fluxes. subroutine calculateBuoyancyFlux1d(G, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux, netHeatMinusSW, netSalt ) -! This subtourine calculates the surface buoyancy flux by adding up the heat, -! FW and salt fluxes and linearizing about the surface state. + ! This subtourine calculates the surface buoyancy flux by adding up the heat, + ! FW and salt fluxes and linearizing about the surface state. type(ocean_grid_type), intent(in) :: G ! ocean grid type(forcing), intent(in) :: fluxes ! surface fluxes/forcing type @@ -409,7 +467,7 @@ subroutine calculateBuoyancyFlux1d(G, fluxes, optics, h, Temp, Salt, tv, j, buoy real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: Temp ! potential or conservative temp (degrees C) real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: Salt ! salinity (ppt) type(thermo_var_ptrs), intent(inout) :: tv ! thermodynamics type (out needed for tv%TempxPmE ????) - integer, intent(in) :: j ! j-index of row to work on + integer, intent(in) :: j ! j-index of row to work on real, dimension(NIMEM_,NK_INTERFACE_), intent(inout) :: buoyancyFlux ! buoyancy flux (m2/s3) real, dimension(NIMEM_), intent(inout) :: netHeatMinusSW ! heat flux excluding SW (K m/s) real, dimension(NIMEM_), intent(inout) :: netSalt ! net salt flux (ppt m/s) @@ -433,7 +491,7 @@ subroutine calculateBuoyancyFlux1d(G, fluxes, optics, h, Temp, Salt, tv, j, buoy nsw = optics%nbands -! smg: what do we do when have heat fluxes from calving and river? + ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. useCalvingHeatContent = .False. @@ -450,11 +508,11 @@ subroutine calculateBuoyancyFlux1d(G, fluxes, optics, h, Temp, Salt, tv, j, buoy ! Fetch the fresh-water, heat and salt fluxes ! netH is the fresh-water flux - ! netSalt is the salt flux (typically zero except under sea-ice) + ! netSalt is the salt flux (typically zero except under sea-ice or nonzero surface restoring) ! netHeat is the heat flux EXCEPT the penetrating SW ! penSWbnd is the surface SW for each band - call extractFluxes1d(G, fluxes, optics, nsw, j, dt, & - depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & + call extractFluxes1d(G, fluxes, optics, nsw, j, dt, & + depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent,& h(:,j,:), Temp(:,j,:), netH, netHeatMinusSW, netSalt, penSWbnd, tv) ! Sum over bands and attenuate as a function of depth @@ -483,7 +541,7 @@ subroutine calculateBuoyancyFlux1d(G, fluxes, optics, h, Temp, Salt, tv, j, buoy end subroutine calculateBuoyancyFlux1d - +!> 2d wrapper to compute surface buoyancy fluxes. subroutine calculateBuoyancyFlux2d(G, fluxes, optics, h, Temp, Salt, tv, buoyancyFlux, netHeatMinusSW, netSalt) ! This subtourine calculates the surface buoyancy flux by adding up the heat, @@ -517,6 +575,7 @@ subroutine calculateBuoyancyFlux2d(G, fluxes, optics, h, Temp, Salt, tv, buoyanc end subroutine calculateBuoyancyFlux2d +!> Apply shortwave heating below mixed layer. subroutine absorbRemainingSW(G, h, eps, htot, opacity_band, nsw, j, dt, & H_limit_fluxes, correctAbsorption, absorbAllSW, & ksort, T, Ttot, Pen_SW_bnd) @@ -705,6 +764,7 @@ subroutine absorbRemainingSW(G, h, eps, htot, opacity_band, nsw, j, dt, & end subroutine absorbRemainingSW +!> Apply shortwave heating below mixed layer. subroutine sumSWoverBands(G, h, eps, htot, opacity_band, nsw, j, dt, & H_limit_fluxes, correctAbsorption, absorbAllSW, & ksort, iPen_SW_bnd, netPen) @@ -865,8 +925,9 @@ subroutine sumSWoverBands(G, h, eps, htot, opacity_band, nsw, j, dt, & end subroutine sumSWoverBands +!> Write out chksums for basic state variables. subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) -! this subroutine writes out chksums for the model's basic state variables. + character(len=*), intent(in) :: mesg type(forcing), intent(in) :: fluxes @@ -879,7 +940,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) ! (in) h - Layer thickness, in m. ! (in) uh - Volume flux through zonal faces = u*h*dy, m3 s-1. ! (in) vh - Volume flux through meridional faces = v*h*dx, in m3 s-1. -! (in) G - The ocean's grid structure. +! (in) G - The ocean grid structure. integer :: is, ie, js, je, nz, hshift is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -910,6 +971,12 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%lw, mesg//" fluxes%lw",G,haloshift=hshift) if (associated(fluxes%latent)) & call hchksum(fluxes%latent, mesg//" fluxes%latent",G,haloshift=hshift) + if (associated(fluxes%latent_evap)) & + call hchksum(fluxes%latent_evap, mesg//" fluxes%latent_evap",G,haloshift=hshift) + if (associated(fluxes%latent_fprec)) & + call hchksum(fluxes%latent_fprec, mesg//" fluxes%latent_fprec",G,haloshift=hshift) + if (associated(fluxes%latent_calve)) & + call hchksum(fluxes%latent_calve, mesg//" fluxes%latent_calve",G,haloshift=hshift) if (associated(fluxes%sens)) & call hchksum(fluxes%sens, mesg//" fluxes%sens",G,haloshift=hshift) if (associated(fluxes%evap)) & @@ -920,6 +987,8 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%froz_precip, mesg//" fluxes%froz_precip",G,haloshift=hshift) if (associated(fluxes%virt_precip)) & call hchksum(fluxes%virt_precip, mesg//" fluxes%virt_precip",G,haloshift=hshift) + if (associated(fluxes%seaice_melt)) & + call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",G,haloshift=hshift) if (associated(fluxes%p_surf)) & call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",G,haloshift=hshift) if (associated(fluxes%salt_flux)) & @@ -932,14 +1001,15 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%liq_runoff, mesg//" fluxes%liq_runoff",G,haloshift=hshift) if (associated(fluxes%froz_runoff)) & call hchksum(fluxes%froz_runoff, mesg//" fluxes%froz_runoff",G,haloshift=hshift) - if (associated(fluxes%runoff_hflx)) & - call hchksum(fluxes%runoff_hflx, mesg//" fluxes%runoff_hflx",G,haloshift=hshift) - if (associated(fluxes%calving_hflx)) & - call hchksum(fluxes%calving_hflx, mesg//" fluxes%calving_hflx",G,haloshift=hshift) + if (associated(fluxes%runoff_heat_content)) & + call hchksum(fluxes%runoff_heat_content, mesg//" fluxes%runoff_heat_content",G,haloshift=hshift) + if (associated(fluxes%calving_heat_content)) & + call hchksum(fluxes%calving_heat_content, mesg//" fluxes%calving_heat_content",G,haloshift=hshift) end subroutine MOM_forcing_chksum + +!> Write out values of the fluxes arrays at the i,j location subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) -! This subroutine writes out values of the fluxes arrays at the i,j location type(forcing), intent(in) :: fluxes type(ocean_grid_type), intent(in) :: G @@ -959,69 +1029,379 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) call locMsg(fluxes%sw_nir_dif,'sw_nir_dif') call locMsg(fluxes%lw,'lw') call locMsg(fluxes%latent,'latent') + call locMsg(fluxes%latent_evap,'latent_evap') + call locMsg(fluxes%latent_fprec,'latent_fprec') + call locMsg(fluxes%latent_calve,'latent_calve') call locMsg(fluxes%sens,'sens') call locMsg(fluxes%evap,'evap') call locMsg(fluxes%liq_precip,'liq_precip') call locMsg(fluxes%froz_precip,'froz_precip') call locMsg(fluxes%virt_precip,'virt_precip') + call locMsg(fluxes%seaice_melt,'seaice_melt') call locMsg(fluxes%p_surf,'p_surf') call locMsg(fluxes%salt_flux,'salt_flux') call locMsg(fluxes%TKE_tidal,'TKE_tidal') call locMsg(fluxes%ustar_tidal,'ustar_tidal') call locMsg(fluxes%liq_runoff,'liq_runoff') call locMsg(fluxes%froz_runoff,'froz_runoff') - call locMsg(fluxes%runoff_hflx,'runoff_hflx') - call locMsg(fluxes%calving_hflx,'calving_hflx') + call locMsg(fluxes%runoff_heat_content,'runoff_heat_content') + call locMsg(fluxes%calving_heat_content,'calving_heat_content') contains subroutine locMsg(array,aname) real, dimension(:,:), pointer :: array - character(len=*) :: aname + character(len=*) :: aname + if (associated(array)) then write(0,'(3a,es15.3)') 'MOM_forcing_type, forcing_SinglePointPrint: ',trim(aname),' = ',array(i,j) else write(0,'(4a)') 'MOM_forcing_type, forcing_SinglePointPrint: ',trim(aname),' is not associated.' endif + end subroutine locMsg + end subroutine forcing_SinglePointPrint + +!> Register members of the forcing type for diagnostics +subroutine register_forcing_type_diags(Time, diag, use_temperature, handles) + type(time_type), intent(in) :: Time + type(diag_ctrl), intent(in) :: diag + logical, intent(in) :: use_temperature !< True if T/S are in use + type(forcing_diags), intent(inout) :: handles + + ! Clock for forcing diagnostics + handles%id_clock_forcing=cpu_clock_id('(Ocean forcing diagnostics)', grain=CLOCK_ROUTINE) + + + handles%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, Time, & + 'Zonal surface stress from ocean interactions with atmos and ice', 'Pascal',& + standard_name='surface_downward_x_stress') + + handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & + 'Meridional surface stress ocean interactions with atmos and ice', 'Pascal',& + standard_name='surface_downward_y_stress') + + handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & + 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', 'meter second-1') + + if (.not. use_temperature) then + handles%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, Time, & + 'Buoyancy forcing', 'meter2 second-3') + return + endif + + + handles%id_prcme = register_diag_field('ocean_model', 'PRCmE', diag%axesT1, Time, & + 'Net surface water flux (precip+liq runoff+ice calving-evap)', 'kilogram meter-2 second-1', & + standard_name='water_flux_into_sea_water') + + handles%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & + 'Evaporation/condensation at ocean surface (evaporation is negative)', 'kilogram meter-2 second-1',& + standard_name='water_evaporation_flux') + + ! smg: seaice_melt field requires updates to the sea ice model + handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', diag%axesT1, Time, & + 'water flux to ocean from sea ice melt(> 0) or form(< 0)','kilogram meter-2 second-1', & + standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics') + + handles%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & + 'Liquid + frozen precipitation into ocean', 'kilogram meter-2 second-1') + + handles%id_froz_precip = register_diag_field('ocean_model', 'froz_precip', diag%axesT1, Time, & + 'Frozen precipitation into ocean', 'kilogram meter-2 second-1', & + standard_name='snowfall_flux') + + handles%id_liq_precip = register_diag_field('ocean_model', 'liq_precip', diag%axesT1, Time, & + 'Liquid precipitation into ocean', 'kilogram meter-2 second-1', & + standard_name='rainfall_flux') + + handles%id_virt_precip = register_diag_field('ocean_model', 'virt_precip', diag%axesT1, Time, & + 'Virtual precipitation into ocean (due to salinity restoring)', 'kilogram meter-2 second-1') + + handles%id_froz_runoff = register_diag_field('ocean_model', 'froz_runoff', diag%axesT1, Time, & + 'Frozen runoff (calving) into ocean', 'kilogram meter-2 second-1', & + standard_name='water_flux_into_sea_water_from_icebergs') + + handles%id_liq_runoff = register_diag_field('ocean_model', 'liq_runoff', diag%axesT1, Time, & + 'Liquid runoff (rivers) into ocean', 'kilogram meter-2 second-1', & + standard_name='water_flux_into_sea_water_from_rivers') + + handles%id_calving_heat_content = register_diag_field('ocean_model', 'calving_heat_content', diag%axesT1, Time, & + 'Heat content of frozen runoff (calving) into ocean', 'Watt meter-2', & + standard_name='temperature_flux_due_to_icebergs_expressed_as_heat_flux_into_sea_water') + + handles%id_runoff_heat_content = register_diag_field('ocean_model', 'runoff_heat_content', diag%axesT1, Time, & + 'Heat content of liquid river runoff into ocean', 'Watt meter-2', & + standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water') + + handles%id_precip_heat_content = register_diag_field('ocean_model', 'precip_heat_content', diag%axesT1, Time, & + 'Heat content (relative to oC) of precipitation entering ocean', 'Watt meter-2', & + standard_name='temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water') + + handles%id_evap_heat_content = register_diag_field('ocean_model', 'evap_heat_content', diag%axesT1, Time, & + 'Heat content (relative to 0C) of evaporation into ocean', 'Watt meter-2', & + standard_name='temperature_flux_due_to_evaporation_expressed_as_heat_flux_into_sea_water') + + handles%id_net_heat_coupler = register_diag_field('ocean_model', 'net_heat_coupler', diag%axesT1, Time, & + 'Surface ocean heat flux from SW+LW+latent+sensible (via the coupler)', 'Watt meter-2') + + handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface', diag%axesT1, Time, & + 'Surface ocean heat flux from SW+LW+latent+sensible+mass transfer+frazil', 'Watt meter-2') + + handles%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, Time, & + 'Shortwave radiation flux into ocean', 'Watt meter-2', & + standard_name='surface_net_downward_shortwave_flux') + + handles%id_LwLatSens = register_diag_field('ocean_model', 'LwLatSens', diag%axesT1, Time, & + 'Combined longwave, latent, and sensible heating', 'Watt meter-2') + + handles%id_lw = register_diag_field('ocean_model', 'LW', diag%axesT1, Time, & + 'Longwave radiation flux into ocean', 'Watt meter-2', & + standard_name='surface_net_downward_longwave_flux') + + handles%id_lat = register_diag_field('ocean_model', 'latent', diag%axesT1, Time, & + 'Latent heat flux into ocean due to fusion and evaporation (negative means ocean losses heat)'& + , 'Watt meter-2') + + handles%id_lat_evap = register_diag_field('ocean_model', 'latent_evap', diag%axesT1, Time, & + 'Latent heat flux into ocean due to evaporation/condensation', 'Watt meter-2') + + handles%id_lat_fprec = register_diag_field('ocean_model', 'latent_fprec', diag%axesT1, Time, & + 'Latent heat flux into ocean due to melting of frozen precipitation', 'Watt meter-2') + + handles%id_lat_calve = register_diag_field('ocean_model', 'latent_calve', diag%axesT1, Time, & + 'Latent heat flux into ocean due to melting of frozen ice calving', 'Watt meter-2') + + handles%id_sens = register_diag_field('ocean_model', 'sensible', diag%axesT1, Time, & + 'Sensible heat flux into ocean', 'Watt meter-2', & + standard_name='surface_downward_sensible_heat_flux') + + handles%id_heat_rest = register_diag_field('ocean_model', 'heat_rest', diag%axesT1, Time, & + 'Restoring surface heat flux into ocean', 'Watt meter-2') + + handles%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, Time, & + 'Pressure at ice-ocean or atmosphere-ocean interface', 'Pascal') + + handles%id_saltflux = register_diag_field('ocean_model', 'salt_flux', diag%axesT1, Time, & + 'Salt flux into ocean at surface', 'kilogram meter-2 second-1') + + handles%id_saltFluxIn = register_diag_field('ocean_model', 'salt_flux_in', diag%axesT1, Time, & + 'Salt flux into ocean at surface from coupler', 'kilogram meter-2 second-1') + + handles%id_saltFluxRestore = register_diag_field('ocean_model', 'salt_flux_restore', diag%axesT1, Time, & + 'Salt flux into ocean at surface due to restoring term', 'kilogram meter-2 second-1') + + handles%id_saltFluxGlobalAdj = register_scalar_field('ocean_model', 'salt_flux_global_restoring_adjustment', Time, diag, & + 'Adjustment needed to balance net global salt flux into ocean at surface', 'kilogram meter-2 second-1') + + handles%id_TKE_tidal = register_diag_field('ocean_model', 'TKE_tidal', diag%axesT1, Time, & + 'Tidal source of BBL mixing', 'Watt meter-2') + + +end subroutine register_forcing_type_diags + + +!> Offers forcing fields for diagnostics +subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) + +! This subroutine offers forcing fields for diagnostics. +! These fields must be registered in register_forcing_type_diags. + + type(forcing), intent(in) :: fluxes + type(surface), intent(in) :: state + real, intent(in) :: dt + type(ocean_grid_type), intent(in) :: G + type(diag_ctrl), intent(in) :: diag + type(forcing_diags), intent(inout) :: handles + +! fluxes = A structure containing pointers to any possible +! forcing fields. Unused fields are unallocated. +! dt = time step +! G = ocean grid structure +! diag = structure used to regulate diagnostic output +! handles = ids for diagnostic manager + + real, dimension(SZI_(G),SZJ_(G)) :: sum + real :: C_p ! seawater heat capacity (J K-1 kg-1) + real :: I_dt ! inverse time step + + call cpu_clock_begin(handles%id_clock_forcing) + + C_p = fluxes%C_p + I_dt = 1.0/dt + + if (query_averaging_enabled(diag)) then + + if ((handles%id_taux > 0) .and. ASSOCIATED(fluxes%taux)) & + call post_data(handles%id_taux, fluxes%taux, diag) + if ((handles%id_tauy > 0) .and. ASSOCIATED(fluxes%tauy)) & + call post_data(handles%id_tauy, fluxes%tauy, diag) + if ((handles%id_ustar > 0) .and. ASSOCIATED(fluxes%ustar)) & + call post_data(handles%id_ustar, fluxes%ustar, diag) + + if (handles%id_prcme > 0) then + sum(:,:) = 0.0 + if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:)+fluxes%liq_precip(:,:) + if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:)+fluxes%froz_precip(:,:) + if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:)+fluxes%evap(:,:) + if (ASSOCIATED(fluxes%liq_runoff)) sum(:,:) = sum(:,:)+fluxes%liq_runoff(:,:) + if (ASSOCIATED(fluxes%froz_runoff)) sum(:,:) = sum(:,:)+fluxes%froz_runoff(:,:) + if (ASSOCIATED(fluxes%virt_precip)) sum(:,:) = sum(:,:)+fluxes%virt_precip(:,:) + call post_data(handles%id_prcme, sum, diag) + endif + + if ((handles%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & + call post_data(handles%id_evap, fluxes%evap, diag) + + if ((handles%id_precip > 0) .and. ASSOCIATED(fluxes%liq_precip) & + .and. ASSOCIATED(fluxes%froz_precip)) then + sum(:,:) = fluxes%liq_precip(:,:) + fluxes%froz_precip(:,:) + call post_data(handles%id_precip, sum, diag) + endif + + if ((handles%id_liq_precip > 0) .and. ASSOCIATED(fluxes%liq_precip)) & + call post_data(handles%id_liq_precip, fluxes%liq_precip, diag) + if ((handles%id_froz_precip > 0) .and. ASSOCIATED(fluxes%froz_precip)) & + call post_data(handles%id_froz_precip, fluxes%froz_precip, diag) + if ((handles%id_virt_precip > 0) .and. ASSOCIATED(fluxes%virt_precip)) & + call post_data(handles%id_virt_precip, fluxes%virt_precip, diag) + if ((handles%id_liq_runoff > 0) .and. ASSOCIATED(fluxes%liq_runoff)) & + call post_data(handles%id_liq_runoff, fluxes%liq_runoff, diag) + if ((handles%id_froz_runoff > 0) .and. ASSOCIATED(fluxes%froz_runoff)) & + call post_data(handles%id_froz_runoff, fluxes%froz_runoff, diag) + + if ((handles%id_runoff_heat_content > 0) .and. ASSOCIATED(fluxes%runoff_heat_content)) & + call post_data(handles%id_runoff_heat_content, fluxes%runoff_heat_content, diag) + if ((handles%id_calving_heat_content > 0) .and. ASSOCIATED(fluxes%calving_heat_content)) & + call post_data(handles%id_calving_heat_content, fluxes%calving_heat_content, diag) + + ! this diagnostic should in fact only contain liq_precip contribution. + ! but the prognostic model uses both lprec and fprec, so we need to + ! diagnose the heat flux just as prognostic model handles it. + sum(:,:) = 0.0 + if (handles%id_precip_heat_content > 0) then + if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:) + C_p * fluxes%liq_precip(:,:) * state%SST(:,:) + if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:) + C_p * fluxes%froz_precip(:,:) * state%SST(:,:) + call post_data(handles%id_precip_heat_content, sum, diag) + endif + + if ((handles%id_evap_heat_content > 0) .and. ASSOCIATED(fluxes%evap)) then + sum(:,:) = C_p * fluxes%evap(:,:) * state%SST(:,:) + call post_data(handles%id_evap_heat_content, sum, diag) + endif + + if (handles%id_net_heat_coupler > 0) then + sum(:,:) = 0.0 + if (ASSOCIATED(fluxes%LW)) sum(:,:) = sum(:,:) + fluxes%LW(:,:) + if (ASSOCIATED(fluxes%latent)) sum(:,:) = sum(:,:) + fluxes%latent(:,:) + if (ASSOCIATED(fluxes%sens)) sum(:,:) = sum(:,:) + fluxes%sens(:,:) + if (ASSOCIATED(fluxes%SW)) sum(:,:) = sum(:,:) + fluxes%SW(:,:) + call post_data(handles%id_net_heat_coupler, sum, diag) + endif + if (handles%id_net_heat_surface > 0) then + sum(:,:) = 0.0 + if (ASSOCIATED(fluxes%LW)) sum(:,:) = sum(:,:) + fluxes%LW(:,:) + if (ASSOCIATED(fluxes%latent)) sum(:,:) = sum(:,:) + fluxes%latent(:,:) + if (ASSOCIATED(fluxes%sens)) sum(:,:) = sum(:,:) + fluxes%sens(:,:) + if (ASSOCIATED(fluxes%SW)) sum(:,:) = sum(:,:) + fluxes%SW(:,:) + if (ASSOCIATED(fluxes%runoff_heat_content)) sum(:,:) = sum(:,:) + fluxes%runoff_heat_content(:,:) + if (ASSOCIATED(fluxes%calving_heat_content)) sum(:,:) = sum(:,:) + fluxes%calving_heat_content(:,:) + if (ASSOCIATED(fluxes%liq_precip)) sum(:,:) = sum(:,:) + C_p * fluxes%liq_precip(:,:) * state%SST(:,:) + if (ASSOCIATED(fluxes%froz_precip)) sum(:,:) = sum(:,:) + C_p * fluxes%froz_precip(:,:) * state%SST(:,:) + if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:) + C_p * fluxes%evap(:,:) * state%SST(:,:) + if (ASSOCIATED(state%frazil)) sum(:,:) = sum(:,:) + state%frazil(:,:) * I_dt + call post_data(handles%id_net_heat_surface, sum, diag) + endif + if ((handles%id_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & + ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then + sum(:,:) = (fluxes%lw(:,:) + fluxes%latent(:,:)) + fluxes%sens(:,:) + call post_data(handles%id_LwLatSens, sum, diag) + endif + + if ((handles%id_sw > 0) .and. ASSOCIATED(fluxes%sw)) & + call post_data(handles%id_sw, fluxes%sw, diag) + if ((handles%id_LW > 0) .and. ASSOCIATED(fluxes%lw)) & + call post_data(handles%id_LW, fluxes%lw, diag) + if ((handles%id_lat > 0) .and. ASSOCIATED(fluxes%latent)) & + call post_data(handles%id_lat, fluxes%latent, diag) + if ((handles%id_lat_evap > 0) .and. ASSOCIATED(fluxes%latent_evap)) & + call post_data(handles%id_lat_evap, fluxes%latent_evap, diag) + if ((handles%id_lat_fprec > 0) .and. ASSOCIATED(fluxes%latent_fprec)) & + call post_data(handles%id_lat_fprec, fluxes%latent_fprec, diag) + if ((handles%id_lat_fprec > 0) .and. ASSOCIATED(fluxes%latent_fprec)) & + call post_data(handles%id_lat_calve, fluxes%latent_calve, diag) + if ((handles%id_sens > 0) .and. ASSOCIATED(fluxes%sens)) & + call post_data(handles%id_sens, fluxes%sens, diag) + if ((handles%id_heat_rest > 0) .and. ASSOCIATED(fluxes%heat_restore)) & + call post_data(handles%id_heat_rest, fluxes%heat_restore, diag) + + if ((handles%id_psurf > 0) .and. ASSOCIATED(fluxes%p_surf)) & + call post_data(handles%id_psurf, fluxes%p_surf, diag) + if ((handles%id_saltflux > 0) .and. ASSOCIATED(fluxes%salt_flux)) & + call post_data(handles%id_saltflux, fluxes%salt_flux, diag) + if ((handles%id_saltFluxRestore > 0) .and. ASSOCIATED(fluxes%salt_flux_restore)) & + call post_data(handles%id_saltFluxRestore, fluxes%salt_flux_restore, diag) + if ((handles%id_saltFluxGlobalAdj > 0)) & + call post_data(handles%id_saltFluxGlobalAdj, fluxes%Sflux_adj_total, diag) + if (handles%id_saltFluxIn > 0 .and. ASSOCIATED(fluxes%salt_flux_in)) & + call post_data(handles%id_saltFluxIn, fluxes%salt_flux_in, diag) + + + if ((handles%id_TKE_tidal > 0) .and. ASSOCIATED(fluxes%TKE_tidal)) & + call post_data(handles%id_TKE_tidal, fluxes%TKE_tidal, diag) + + if ((handles%id_buoy > 0) .and. ASSOCIATED(fluxes%buoy)) & + call post_data(handles%id_buoy, fluxes%buoy, diag) + + endif + + call cpu_clock_end(handles%id_clock_forcing) +end subroutine forcing_diagnostics + + + !> Deallocates the forcing type subroutine deallocate_forcing_type(fluxes) type(forcing), intent(inout) :: fluxes - if (associated(fluxes%taux)) deallocate(fluxes%taux) - if (associated(fluxes%tauy)) deallocate(fluxes%tauy) - if (associated(fluxes%ustar)) deallocate(fluxes%ustar) - if (associated(fluxes%buoy)) deallocate(fluxes%buoy) - if (associated(fluxes%sw)) deallocate(fluxes%sw) - if (associated(fluxes%sw_vis_dir)) deallocate(fluxes%sw_vis_dir) - if (associated(fluxes%sw_vis_dif)) deallocate(fluxes%sw_vis_dif) - if (associated(fluxes%sw_nir_dir)) deallocate(fluxes%sw_nir_dir) - if (associated(fluxes%sw_nir_dif)) deallocate(fluxes%sw_nir_dif) - if (associated(fluxes%lw)) deallocate(fluxes%lw) - if (associated(fluxes%latent)) deallocate(fluxes%latent) - if (associated(fluxes%sens)) deallocate(fluxes%sens) - if (associated(fluxes%heat_restore)) deallocate(fluxes%heat_restore) - if (associated(fluxes%runoff_hflx)) deallocate(fluxes%runoff_hflx) - if (associated(fluxes%calving_hflx)) deallocate(fluxes%calving_hflx) - if (associated(fluxes%evap)) deallocate(fluxes%evap) - if (associated(fluxes%liq_precip)) deallocate(fluxes%liq_precip) - if (associated(fluxes%froz_precip)) deallocate(fluxes%froz_precip) - if (associated(fluxes%virt_precip)) deallocate(fluxes%virt_precip) - if (associated(fluxes%liq_runoff)) deallocate(fluxes%liq_runoff) - if (associated(fluxes%froz_runoff)) deallocate(fluxes%froz_runoff) - if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) - if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) - if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) - if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) - if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) - if (associated(fluxes%ustar_shelf)) deallocate(fluxes%ustar_shelf) - if (associated(fluxes%frac_shelf_h)) deallocate(fluxes%frac_shelf_h) - if (associated(fluxes%frac_shelf_u)) deallocate(fluxes%frac_shelf_u) - if (associated(fluxes%frac_shelf_v)) deallocate(fluxes%frac_shelf_v) - if (associated(fluxes%rigidity_ice_u)) deallocate(fluxes%rigidity_ice_u) - if (associated(fluxes%rigidity_ice_v)) deallocate(fluxes%rigidity_ice_v) - if (associated(fluxes%tr_fluxes)) deallocate(fluxes%tr_fluxes) + if (associated(fluxes%taux)) deallocate(fluxes%taux) + if (associated(fluxes%tauy)) deallocate(fluxes%tauy) + if (associated(fluxes%ustar)) deallocate(fluxes%ustar) + if (associated(fluxes%buoy)) deallocate(fluxes%buoy) + if (associated(fluxes%sw)) deallocate(fluxes%sw) + if (associated(fluxes%sw_vis_dir)) deallocate(fluxes%sw_vis_dir) + if (associated(fluxes%sw_vis_dif)) deallocate(fluxes%sw_vis_dif) + if (associated(fluxes%sw_nir_dir)) deallocate(fluxes%sw_nir_dir) + if (associated(fluxes%sw_nir_dif)) deallocate(fluxes%sw_nir_dif) + if (associated(fluxes%lw)) deallocate(fluxes%lw) + if (associated(fluxes%latent)) deallocate(fluxes%latent) + if (associated(fluxes%latent_evap)) deallocate(fluxes%latent_evap) + if (associated(fluxes%latent_fprec)) deallocate(fluxes%latent_fprec) + if (associated(fluxes%latent_calve)) deallocate(fluxes%latent_calve) + if (associated(fluxes%sens)) deallocate(fluxes%sens) + if (associated(fluxes%heat_restore)) deallocate(fluxes%heat_restore) + if (associated(fluxes%runoff_heat_content)) deallocate(fluxes%runoff_heat_content) + if (associated(fluxes%calving_heat_content)) deallocate(fluxes%calving_heat_content) + if (associated(fluxes%evap)) deallocate(fluxes%evap) + if (associated(fluxes%liq_precip)) deallocate(fluxes%liq_precip) + if (associated(fluxes%froz_precip)) deallocate(fluxes%froz_precip) + if (associated(fluxes%virt_precip)) deallocate(fluxes%virt_precip) + if (associated(fluxes%liq_runoff)) deallocate(fluxes%liq_runoff) + if (associated(fluxes%froz_runoff)) deallocate(fluxes%froz_runoff) + if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt) + if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) + if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) + if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) + if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) + if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) + if (associated(fluxes%ustar_shelf)) deallocate(fluxes%ustar_shelf) + if (associated(fluxes%frac_shelf_h)) deallocate(fluxes%frac_shelf_h) + if (associated(fluxes%frac_shelf_u)) deallocate(fluxes%frac_shelf_u) + if (associated(fluxes%frac_shelf_v)) deallocate(fluxes%frac_shelf_v) + if (associated(fluxes%rigidity_ice_u)) deallocate(fluxes%rigidity_ice_u) + if (associated(fluxes%rigidity_ice_v)) deallocate(fluxes%rigidity_ice_v) + if (associated(fluxes%tr_fluxes)) deallocate(fluxes%tr_fluxes) end subroutine deallocate_forcing_type end module MOM_forcing_type