From 3b4ea9c7bb4b327abb4d931153ddfb30825533a0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 4 Oct 2019 11:36:33 -0400 Subject: [PATCH] +Turned heat budget pointers into arrays Turned pointers to heat budget elements in the surface type into arrays, so that the internal units can be changed without impacting the externally used arrays. This also included passing in a thermo_var_ptrs type as a new argument to accumulate_net_input, which is appropriate now that this routine is only called from inside of step_MOM. All answers are bitwise identical, but an interface has a new argument. --- src/core/MOM.F90 | 28 +++++++++++++++++++++++++--- src/core/MOM_variables.F90 | 21 ++++++++++----------- src/diagnostics/MOM_sum_output.F90 | 18 ++++++++++-------- 3 files changed, 45 insertions(+), 22 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a99e6d7624..db3399c398 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -851,7 +851,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Accumulate the surface fluxes for assessing conservation if (do_thermo .and. fluxes%fluxes_used) & - call accumulate_net_input(fluxes, sfc_state, fluxes%dt_buoy_accum, & + call accumulate_net_input(fluxes, sfc_state, CS%tv, fluxes%dt_buoy_accum, & G, CS%sum_output_CSp) if (MOM_state_is_synchronized(CS)) & @@ -2737,8 +2737,6 @@ subroutine extract_surface_state(CS, sfc_state) call allocate_surface_state(sfc_state, G, use_temperature, do_integrals=.true.) endif sfc_state%frazil => CS%tv%frazil - sfc_state%TempxPmE => CS%tv%TempxPmE - sfc_state%internal_heat => CS%tv%internal_heat sfc_state%T_is_conT = CS%tv%T_is_conT sfc_state%S_is_absS = CS%tv%S_is_absS if (associated(CS%visc%taux_shelf)) sfc_state%taux_shelf => CS%visc%taux_shelf @@ -2927,6 +2925,30 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%salt_deficit(i,j) = 1000.0 * CS%tv%salt_deficit(i,j) enddo ; enddo endif + if (allocated(sfc_state%TempxPmE) .and. associated(CS%tv%TempxPmE)) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + sfc_state%TempxPmE(i,j) = CS%tv%TempxPmE(i,j) + enddo ; enddo + endif + if (allocated(sfc_state%internal_heat) .and. associated(CS%tv%internal_heat)) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + sfc_state%internal_heat(i,j) = CS%tv%internal_heat(i,j) + enddo ; enddo + endif + if (associated(sfc_state%taux_shelf) .and. associated(CS%visc%taux_shelf)) then + !$OMP parallel do default(shared) + do j=js,je ; do I=is-1,ie + sfc_state%taux_shelf(I,j) = CS%visc%taux_shelf(I,j) + enddo ; enddo + endif + if (associated(sfc_state%tauy_shelf) .and. associated(CS%visc%tauy_shelf)) then + !$OMP parallel do default(shared) + do J=js-1,je ; do i=is,ie + sfc_state%tauy_shelf(i,J) = CS%visc%tauy_shelf(i,J) + enddo ; enddo + endif if (allocated(sfc_state%ocean_mass) .and. allocated(sfc_state%ocean_heat) .and. & allocated(sfc_state%ocean_salt)) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 36148f69ba..cca22cf31b 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -50,8 +50,12 @@ module MOM_variables ocean_mass, & !< The total mass of the ocean [kg m-2]. ocean_heat, & !< The total heat content of the ocean in [degC kg m-2]. ocean_salt, & !< The total salt content of the ocean in [kgSalt m-2]. - salt_deficit !< The salt needed to maintain the ocean column at a minimum + TempxPmE, & !< The net inflow of water into the ocean times the temperature at which this + !! inflow occurs during the call to step_MOM [degC kg m-2]. + salt_deficit, & !< The salt needed to maintain the ocean column at a minimum !! salinity of 0.01 PSU over the call to step_MOM [kgSalt m-2]. + internal_heat !< Any internal or geothermal heat sources that are applied to the ocean + !! integrated over the call to step_MOM [degC kg m-2]. logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the !! conservative temperature in [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the @@ -62,13 +66,6 @@ module MOM_variables real, pointer, dimension(:,:) :: frazil => NULL() !< The energy needed to heat the ocean column to the freezing point during the call !! to step_MOM [J m-2]. - real, pointer, dimension(:,:) :: TempxPmE => NULL() - !< The net inflow of water into the ocean times the temperature at which this inflow - !! occurs during the call to step_MOM [degC kg m-2]. This should be prescribed in the - !! forcing fields, but as it often is not, this is a useful heat budget diagnostic. - real, pointer, dimension(:,:) :: internal_heat => NULL() - !< Any internal or geothermal heat sources that are applied to the ocean integrated - !! over the call to step_MOM [degC kg m-2]. type(coupler_2d_bc_type) :: tr_fields !< A structure that may contain an !! array of named fields describing tracer-related quantities. !### NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING CONVENTION AND HAVE NO @@ -127,8 +124,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & T => NULL(), & !< Pointer to the temperature state variable [degC] S => NULL(), & !< Pointer to the salinity state variable [ppt ~> PSU or g/kg] - u => NULL(), & !< Pointer to the zonal velocity [m s-1] - v => NULL(), & !< Pointer to the meridional velocity [m s-1] + u => NULL(), & !< Pointer to the zonal velocity [L T-1 ~> m s-1] + v => NULL(), & !< Pointer to the meridional velocity [L T-1 ~> m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -349,8 +346,10 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (use_temp) then allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0 + allocate(sfc_state%TempxPmE(isd:ied,jsd:jed)) ; sfc_state%TempxPmE(:,:) = 0.0 + allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 + allocate(sfc_state%internal_heat(isd:ied,jsd:jed)) ; sfc_state%internal_heat(:,:) = 0.0 endif - allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 endif if (present(gas_fields_ocn)) & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 9d8cff542f..1a8a9879b3 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -936,11 +936,13 @@ end subroutine write_energy !> This subroutine accumates the net input of volume, salt and heat, through !! the ocean surface for use in diagnosing conservation. -subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) +subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, CS) type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible !! forcing fields. Unused fields are unallocated. type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. real, intent(in) :: dt !< The amount of time over which to average [s]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call @@ -1004,7 +1006,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & ! + (fluxes%heat_content_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1012,9 +1014,9 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! enddo ; enddo ; endif ! smg: old code - if (associated(sfc_state%TempxPmE)) then + if (associated(tv%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * sfc_state%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * tv%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie @@ -1024,14 +1026,14 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. - if (associated(sfc_state%internal_heat)) then + if (associated(tv%internal_heat)) then do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * & - sfc_state%internal_heat(i,j) + tv%internal_heat(i,j) enddo ; enddo endif - if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * sfc_state%frazil(i,j) + if (associated(tv%frazil)) then ; do j=js,je ; do i=is,ie + heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * tv%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j)