diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 370cc9ad99..ce699b1397 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -14,9 +14,10 @@ module MOM_surface_forcing use MOM_domains, only : pass_vector, pass_var, fill_symmetric_edges use MOM_domains, only : global_field_sum, BITWISE_EXACT_SUM use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All +use MOM_domains, only : To_North, To_East, Omit_Corners 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, mech_forcing, copy_common_forcing_fields +use MOM_forcing_type, only : forcing, mech_forcing use MOM_forcing_type, only : forcing_diags, mech_forcing_diags, register_forcing_type_diags use MOM_forcing_type, only : allocate_forcing_type, deallocate_forcing_type use MOM_forcing_type, only : allocate_mech_forcing, deallocate_mech_forcing @@ -44,7 +45,7 @@ module MOM_surface_forcing #include -public convert_IOB_to_fluxes +public convert_IOB_to_fluxes, convert_IOB_to_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -128,13 +129,15 @@ module MOM_surface_forcing character(len=30) :: salt_restore_var_name ! name of surface salinity in salt_restore_file logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface ! salinity restoring fluxes. The masking file should be - ! in inputdir/salt_restore_mask.nc and the field should be name 'mask' + ! in inputdir/salt_restore_mask.nc and the field should + ! be named 'mask' real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring character(len=200) :: temp_restore_file ! filename for sst restoring data character(len=30) :: temp_restore_var_name ! name of surface temperature in temp_restore_file logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface ! temperature restoring fluxes. The masking file should be - ! in inputdir/temp_restore_mask.nc and the field should be name 'mask' + ! in inputdir/temp_restore_mask.nc and the field should + ! be named 'mask' real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring integer :: id_srestore = -1 ! id number for time_interp_external. integer :: id_trestore = -1 ! id number for time_interp_external. @@ -152,49 +155,54 @@ module MOM_surface_forcing ! the elements, units, and conventions that exactly conform to the use for ! MOM-based coupled models. 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(:,:) :: ustar_berg =>NULL() ! frictional velocity beneath icebergs (m/s) - real, pointer, dimension(:,:) :: area_berg =>NULL() ! area covered by icebergs(m2/m2) - real, pointer, dimension(:,:) :: mass_berg =>NULL() ! mass of icebergs(kg/m2) - 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 - ! passive tracer fluxes. - integer :: wind_stagger = -999 ! A flag indicating the spatial discretization of - ! wind stresses. This flag may be set by the - ! flux-exchange code, based on what the sea-ice - ! model is providing. Otherwise, the value from - ! the surface_forcing_CS is used. + 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(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s) + real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) + real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) + 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) + real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and + !! ice-shelves, expressed as a coefficient + !! for divergence damping, as determined + !! outside of the ocean model in (m3/s) + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of + !! named fields used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of + !! wind stresses. This flag may be set by the + !! flux-exchange code, based on what the sea-ice + !! model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type integer :: id_clock_forcing contains -subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, & +!> This subroutine translates the Ice_ocean_boundary_type into a MOM +!! thermodynamic forcing type, including changes of units, sign conventions, +!! and putting the fields into arrays with MOM-standard halos. +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure containing pointers to !! all possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. @@ -206,34 +214,11 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the !! surface state of the ocean. - logical, optional, intent(in) :: restore_salt, restore_temp - -! This subroutine translates the Ice_ocean_boundary_type into a -! MOM forcing type, including changes of units, sign conventions, -! and puting the fields into arrays with MOM-standard halos. - -! Arguments: -! IOB ice-ocean boundary type w/ fluxes to drive ocean in a coupled model -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) index_bounds - the i- and j- size of the arrays in IOB. -! (in) Time - The time of the fluxes, used for interpolating the salinity -! to the right time, when it is being restored. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) state - A structure containing fields that describe the -! surface state of the ocean. -! (in) restore_salt - if true, salinity is restored to a target value. -! (in) restore_temp - if true, temperature is restored to a target value. + logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. + logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h, & ! Meridional wind stresses at h points (Pa) data_restore, & ! The surface value toward which to restore (g/kg or degC) SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C) SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value (g/kg) @@ -247,16 +232,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, ! sum, used with units of m2 or (kg/s) open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 ! squared wind stresses (Pa^2) - real :: tau_mag ! magnitude of the wind stress (Pa) - real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) - real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) - real :: mass_ice ! mass of sea ice at a face (kg/m^2) - real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) - - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -282,7 +257,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 C_p = fluxes%C_p - Irho0 = 1.0/CS%Rho0 open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -302,8 +276,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, if (fluxes%dt_buoy_accum < 0) then call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & ustar=.true., press=.true.) - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -312,6 +284,11 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + if (CS%use_limited_P_SSH) then + fluxes%p_surf_SSH => fluxes%p_surf + else + fluxes%p_surf_SSH => fluxes%p_surf_full + endif call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) @@ -330,19 +307,17 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo; enddo - call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) - - if (CS%rigid_sea_ice) then - call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) - call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) - endif - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization + + if (((associated(IOB%ustar_berg) .and. (.not.associated(fluxes%ustar_berg))) & + .or. (associated(IOB%area_berg) .and. (.not.associated(fluxes%area_berg)))) & + .or. (associated(IOB%mass_berg) .and. (.not.associated(fluxes%mass_berg)))) & + call allocate_forcing_type(G, fluxes, iceberg=.true.) + if ((.not.coupler_type_initialized(fluxes%tr_fluxes)) .and. & coupler_type_initialized(IOB%fluxes)) & call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, & @@ -353,8 +328,8 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 endif ! allocation and initialization on first call to this routine @@ -427,22 +402,11 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, if (restore_sst) then call time_interp_external(CS%id_trestore,Time,data_restore) do j=js,je ; do i=is,ie - delta_sst = data_restore(i,j)- sfc_state%SST(i,j) - delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) - fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 - enddo; enddo - endif - - wind_stagger = CS%wind_stagger - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger - if (wind_stagger == BGRID_NE) then - ! This is necessary to fill in the halo points. - taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + delta_sst = data_restore(i,j)- sfc_state%SST(i,j) + delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) + fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + enddo ; enddo endif @@ -450,17 +414,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie - if (wind_stagger == BGRID_NE) then - if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - endif - if (associated(IOB%lprec)) & fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) @@ -476,11 +429,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - if (((associated(IOB%ustar_berg) .and. (.not. associated(fluxes%ustar_berg))) & - .or. (associated(IOB%area_berg) .and. (.not. associated(fluxes%area_berg)))) & - .or. (associated(IOB%mass_berg) .and. (.not. associated(fluxes%mass_berg)))) & - call allocate_forcing_type(G, fluxes, iceberg=.true.) - if (associated(IOB%ustar_berg)) & fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -531,6 +479,21 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, enddo ; enddo + ! applied surface pressure from atmosphere and cryosphere + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + enddo ; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + enddo ; enddo + endif + endif + ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie @@ -583,6 +546,108 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & + coupler_type_initialized(IOB%fluxes)) & + call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) + + if (CS%allow_flux_adjustments) then + ! Apply adjustments to fluxes + call apply_flux_adjustments(G, CS, Time, fluxes) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + +end subroutine convert_IOB_to_fluxes + +!> This subroutine translates the Ice_ocean_boundary_type into a MOM +!! mechanical forcing type, including changes of units, sign conventions, +!! and putting the fields into arrays with MOM-standard halos. +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. + type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the + !! salinity to the right time, when it is being restored. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + + + real, dimension(SZIB_(G),SZJB_(G)) :: & + taux_at_q, & ! Zonal wind stresses at q points (Pa) + tauy_at_q ! Meridional wind stresses at q points (Pa) + + real, dimension(SZI_(G),SZJ_(G)) :: & + rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) + taux_at_h, & ! Zonal wind stresses at h points (Pa) + tauy_at_h ! Meridional wind stresses at h points (Pa) + + real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) + real :: Irho0 ! inverse of the mean density in (m^3/kg) + real :: taux2, tauy2 ! squared wind stresses (Pa^2) + real :: tau_mag ! magnitude of the wind stress (Pa) + real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) + real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) + real :: mass_ice ! mass of sea ice at a face (kg/m^2) + real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) + + integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd + + call cpu_clock_begin(id_clock_forcing) + + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + Irho0 = 1.0/CS%Rho0 + + ! allocation and initialization if this is the first time that this + ! mechanical forcing type has been used. + if (.not.forces%initialized) then + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & + press=.true.) + + call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + + if (CS%rigid_sea_ice) then + call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) + call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) + endif + + forces%initialized = .true. + endif + + if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. & + (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & + call allocate_mech_forcing(G, forces, iceberg=.true.) + if (associated(IOB%ice_rigidity)) then + rigidity_at_h(:,:) = 0.0 + call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) + call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) + endif + + if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 + if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + ! applied surface pressure from atmosphere and cryosphere if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then @@ -596,18 +661,49 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif endif + wind_stagger = CS%wind_stagger + if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & + (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + if (wind_stagger == BGRID_NE) then + ! This is necessary to fill in the halo points. + taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie + if (associated(IOB%area_berg)) & + forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%mass_berg)) & + forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ice_rigidity)) & + rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) + + if (wind_stagger == BGRID_NE) then + if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + elseif (wind_stagger == AGRID) then + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + endif + + enddo ; enddo + ! surface momentum stress related fields as function of staggering if (wind_stagger == BGRID_NE) then if (G%symmetric) & call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) - call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 @@ -644,7 +740,8 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, enddo ; enddo elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & + stagger=AGRID, halo=1) do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 @@ -672,7 +769,7 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, else ! C-grid wind stresses. if (G%symmetric) & call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) - call pass_vector(forces%taux, forces%tauy, G%Domain) + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) do j=js,je ; do i=is,ie taux2 = 0.0 @@ -694,72 +791,71 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, endif ! endif for wind related fields + ! sea ice related dynamic fields + if (associated(IOB%ice_rigidity)) then + call pass_var(rigidity_at_h, G%Domain, halo=1) + do I=is-1,ie ; do j=js,je + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + min(rigidity_at_h(i,j), rigidity_at_h(i+1,j)) + enddo ; enddo + do i=is,ie ; do J=js-1,je + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + min(rigidity_at_h(i,j), rigidity_at_h(i,j+1)) + enddo ; enddo + endif - ! sea ice related fields if (CS%rigid_sea_ice) then - ! The commented out code here and in the following lines is the correct - ! version, but the incorrect version is being retained temporarily to avoid - ! changing answers. - call pass_var(forces%p_surf_full, G%Domain) + call pass_var(forces%p_surf_full, G%Domain, halo=1) I_GEarth = 1.0 / G%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=isd,ied-1 ; do j=jsd,jed + do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth mass_eff = 0.0 if (mass_ice > CS%rigid_sea_ice_mass) then mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & (mass_ice + CS%rigid_sea_ice_mass) endif - ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this - ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff enddo ; enddo - do i=isd,ied ; do J=jsd,jed-1 + do i=is,ie ; do J=js-1,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth mass_eff = 0.0 if (mass_ice > CS%rigid_sea_ice_mass) then mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & (mass_ice + CS%rigid_sea_ice_mass) endif - forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff enddo ; enddo endif - if (coupler_type_initialized(fluxes%tr_fluxes) .and. & - coupler_type_initialized(IOB%fluxes)) & - call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) - if (CS%allow_flux_adjustments) then - ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, forces, fluxes) + ! Apply adjustments to forces + call apply_force_adjustments(G, CS, Time, forces) endif - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) +!### ! Allow for user-written code to alter fluxes after all the above +!### call user_alter_mech_forcing(forces, Time, G, CS%urf_CS) call cpu_clock_end(id_clock_forcing) -end subroutine convert_IOB_to_fluxes +end subroutine convert_IOB_to_forces -!> Adds flux adjustments obtained via data_override +!> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: -!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) -!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) -subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) +!! - hflx_adj (Heat flux into the ocean, in W m-2) +!! - sflx_adj (Salt flux into the ocean, in kg salt m-2 s-1) +!! - prcme_adj (Fresh water flux into the ocean, in kg m-2 s-1) +subroutine apply_flux_adjustments(G, CS, Time, fluxes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h ! Fluxes at h points (W m-2 or kg m-2 s-1) integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y, overrode_h + logical :: overrode_h isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec @@ -769,7 +865,7 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif - if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) + ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) overrode_h = .false. call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) @@ -777,7 +873,7 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif - if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) + ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) overrode_h = .false. call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) @@ -785,7 +881,29 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif - if (overrode_h) call pass_var(fluxes%vprec, G%Domain) + ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) +end subroutine apply_flux_adjustments + +!> Adds mechanical forcing adjustments obtained via data_override +!! Component name is 'OCN' +!! Available adjustments are: +!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) +!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) +subroutine apply_force_adjustments(G, CS, Time, forces) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure + type(time_type), intent(in) :: Time !< Model time structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y + + isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged @@ -798,7 +916,7 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) "Both taux_adj and tauy_adj must be specified, or neither, in data_table") ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID, halo=1) do j=jsc-1,jec+1 ; do i=isc-1,iec+1 dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) @@ -822,7 +940,7 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) enddo ; enddo endif ! overrode_x .or. overrode_y -end subroutine apply_flux_adjustments +end subroutine apply_force_adjustments subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -1229,11 +1347,11 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) if (associated(iobt%ustar_berg)) & - write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) + write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) if (associated(iobt%area_berg)) & - write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) + write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) if (associated(iobt%mass_berg)) & - write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) + write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index d153a2f04c..af4dddbadb 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -24,10 +24,12 @@ module ocean_model_mod use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end -use MOM_domains, only : pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners 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 : allocate_forcing_type use MOM_forcing_type, only : forcing, mech_forcing use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing @@ -36,10 +38,11 @@ module ocean_model_mod 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 +use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : convert_IOB_to_forces, 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(>) @@ -59,10 +62,8 @@ module ocean_model_mod use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux -use MOM_forcing_type, only : allocate_forcing_type use fms_mod, only : stdout use mpp_mod, only : mpp_chksum -use MOM_domains, only : pass_var, pass_vector, TO_ALL, CGRID_NE, BGRID_NE use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves @@ -141,27 +142,20 @@ module ocean_model_mod type, public :: ocean_state_type ; private ! This type is private, and can therefore vary between different ocean models. logical :: is_ocean_PE = .false. !< True if this is an ocean PE. - type(time_type) :: Time !< The ocean model's time and master clock. - integer :: Restart_control !< An integer that is bit-tested to determine whether - !! incremental restart files are saved and whether they - !! have a time stamped name. +1 (bit 0) for generic - !! files and +2 (bit 1) for time-stamped files. A - !! restart file is saved at the end of a run segment - !! unless Restart_control is negative. + type(time_type) :: Time !< The ocean model's time and master clock. + integer :: Restart_control !< An integer that is bit-tested to determine whether + !! incremental restart files are saved and whether they + !! have a time stamped name. +1 (bit 0) for generic + !! files and +2 (bit 1) for time-stamped files. A + !! restart file is saved at the end of a run segment + !! unless Restart_control is negative. integer :: nstep = 0 !< The number of calls to update_ocean. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. - logical :: use_waves = .false.! If true use wave coupling. - - ! Many of the following variables do not appear to belong here. -RWH - logical :: icebergs_apply_rigid_boundary ! If true, the icebergs can change ocean bd condition. - real :: kv_iceberg ! The viscosity of the icebergs in m2/s (for ice rigidity) - real :: berg_area_threshold ! Fraction of grid cell which iceberg must occupy - !so that fluxes below are set to zero. (0.5 is a - !good value to use. Not applied for negative values. - real :: latent_heat_fusion ! Latent heat of fusion - real :: density_iceberg ! A typical density of icebergs in kg/m3 (for ice rigidity) + logical :: use_waves !< If true use wave coupling. + logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the + !! ocean dynamics and forcing fluxes. logical :: restore_salinity !< If true, the coupled MOM driver adds a term to !! restore salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to @@ -210,6 +204,9 @@ module ocean_model_mod Ice_shelf_CSp => NULL() !< A pointer to the control structure for the !! ice shelf model that couples with MOM6. This !! is null if there is no ice shelf. + type(marine_ice_CS), pointer :: & + marine_ice_CSp => NULL() !< A pointer to the control structure for the + !! marine ice effects module. type(wave_parameters_cs), pointer :: & Waves !< A structure containing pointers to the surface wave fields type(surface_forcing_CS), pointer :: & @@ -357,22 +354,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) - call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, & + call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - if (OS%icebergs_apply_rigid_boundary) then - call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, & - "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) - call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & - "A typical density of icebergs.", units="kg m-3", default=917.0) - call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & - "The latent heat of fusion.", units="J/kg", default=hlf) - call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& - "below berg are set to zero. Not applied for negative \n"//& - " values.", units="non-dim", default=-1.0) - endif - OS%press_to_z = 1.0/(Rho0*G_Earth) ! Consider using a run-time flag to determine whether to do the diagnostic @@ -387,17 +371,16 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & OS%diag, OS%forces, OS%fluxes) endif - if (OS%icebergs_apply_rigid_boundary) then - !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true + if (OS%icebergs_alter_ocean) then + call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp) if (.not. OS%use_ice_shelf) & call allocate_forcing_type(OS%grid, OS%fluxes, shelf=.true.) endif - call get_param(param_file,mdl,"USE_WAVES",OS%Use_Waves,& - "If true, enables surface wave modules.",default=.false.) + call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, & + "If true, enables surface wave modules.", default=.false.) if (OS%use_waves) then - call MOM_wave_interface_init(OS%Time,OS%grid,OS%GV,param_file,OS%Waves,OS%diag) + call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, param_file, OS%Waves, OS%diag) else call MOM_wave_interface_init_lite(param_file) endif @@ -450,7 +433,7 @@ end subroutine ocean_model_init !! storing the new ocean properties in Ocean_state. subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & time_start_update, Ocean_coupling_time_step, & - update_dyn, update_thermo) + update_dyn, update_thermo, Ocn_fluxes_used) type(ice_ocean_boundary_type), & intent(in) :: Ice_ocean_boundary !< A structure containing the !! various forcing fields coming from the ice. @@ -469,6 +452,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & !! due to the ocean dynamics. logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates !! due to the ocean thermodynamics or remapping. + logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the + !! cumulative thermodynamic fluxes from the ocean, + !! like frazil, have been used and should be reset. type(time_type) :: Master_time ! This allows step_MOM to temporarily change ! the time that is seen by internal modules. @@ -488,7 +474,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. - logical :: do_dyn, do_thermo + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je @@ -523,26 +510,30 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & weight = 1.0 + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp) + if (OS%fluxes%fluxes_used) then - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) ! Needed to allow diagnostics in convert_IOB - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%forces, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp, OS%sfc_state, & + OS%restore_salinity, OS%restore_temp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif - if (OS%icebergs_apply_rigid_boundary) then - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%fluxes, OS%use_ice_shelf, & - OS%density_iceberg, OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, & - dt_coupling, OS%berg_area_threshold) + if (OS%icebergs_alter_ocean) then + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. - call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) + call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.) #ifdef _USE_GENERIC_TRACER + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes #endif ! Indicate that there are new unused fluxes. @@ -550,15 +541,17 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%fluxes%dt_buoy_accum = dt_coupling else OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%forces, OS%flux_tmp, index_bnds, OS%Time, & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif - if (OS%icebergs_apply_rigid_boundary) then - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf, OS%density_iceberg, & - OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) + if (OS%icebergs_alter_ocean) then + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) @@ -578,15 +571,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes, & - OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time - if(OS%offline_tracer_mode) then + if (OS%offline_tracer_mode) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + elseif ((.not.do_thermo) .or. (.not.do_dyn)) then + ! The call sequence is being orchestrated from outside of update_ocean_model. + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & + reset_therm=Ocn_fluxes_used) + !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + elseif (OS%single_step_call) then call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else @@ -612,16 +611,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & - do_dynamics=.false., do_thermodynamics=.true., & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) endif call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & - do_dynamics=.true., do_thermodynamics=.false., & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) else call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & - do_dynamics=.true., do_thermodynamics=.false., & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. @@ -638,7 +637,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Back up Time2 to the start of the thermodynamic segment. Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & - do_dynamics=.false., do_thermodynamics=.true., & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif @@ -673,6 +672,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & end subroutine update_ocean_model ! NAME="update_ocean_model" + !======================================================================= ! ! @@ -680,118 +680,15 @@ end subroutine update_ocean_model ! write out restart file. ! Arguments: ! timestamp (optional, intent(in)) : A character string that represents the model time, -! used for writing restart. timestamp will append to +! used for writing restart. timestamp will prepend to ! the any restart file name as a prefix. ! ! - -subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, kv_ice, & - latent_heat_fusion, sfc_state, time_step, berg_area_threshold) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. - real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. - real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. - real, intent(in) :: time_step !< The coupling time step, in s. - real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg -! Arguments: -! (in) fluxes - A structure of surface fluxes that may be used. -! (in) G - The ocean's grid structure. - real :: fraz ! refreezing rate in kg m-2 s-1 - real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. - real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed - !This routine adds iceberg data to the ice shelf data (if ice shelf is used) - !which can then be used to change the top of ocean boundary condition used in - !the ocean model. This routine is taken from the add_shelf_flux subroutine - !within the ice shelf model. - - if (.not. (((associated(fluxes%frac_shelf_h) .and. associated(forces%frac_shelf_u)) & - .and.(associated(forces%frac_shelf_v) .and. associated(fluxes%ustar_shelf)))& - .and.(associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)))) return - - if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & - associated(fluxes%mass_berg) ) ) return - - if (.not. use_ice_shelf) then - fluxes%frac_shelf_h(:,:) = 0. - forces%frac_shelf_u(:,:) = 0. - forces%frac_shelf_v(:,:) = 0. - fluxes%ustar_shelf(:,:) = 0. - forces%rigidity_ice_u(:,:) = 0. - forces%rigidity_ice_v(:,:) = 0. - endif - - kv_rho_ice = kv_ice / density_ice - - do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) - fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) - enddo ; enddo - do j=jsd,jed ; do I=isd,ied-1 - forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & - forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((fluxes%area_berg(i,j)*G%areaT(i,j)) + & - (fluxes%area_berg(i+1,j)*G%areaT(i+1,j))) / & - (G%areaT(i,j) + G%areaT(i+1,j)) ) - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & - min(fluxes%mass_berg(i,j), fluxes%mass_berg(i+1,j)) - enddo ; enddo - do J=jsd,jed-1 ; do i=isd,ied - forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & - forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((fluxes%area_berg(i,j)*G%areaT(i,j)) + & - (fluxes%area_berg(i,j+1)*G%areaT(i,j+1))) / & - (G%areaT(i,j) + G%areaT(i,j+1)) ) - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & - min(fluxes%mass_berg(i,j), fluxes%mass_berg(i,j+1)) - enddo ; enddo - call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - - !Zero'ing out other fluxes under the tabular icebergs - if (berg_area_threshold >= 0.) then - I_dt_LHF = 1.0 / (time_step * latent_heat_fusion) - do j=jsd,jed ; do i=isd,ied - if (fluxes%frac_shelf_h(i,j) > berg_area_threshold) then !Only applying for ice shelf covering most of cell - - if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 - if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 - if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 - if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 - - ! Add frazil formation diagnosed by the ocean model (J m-2) in the - ! form of surface layer evaporation (kg m-2 s-1). Update lprec in the - ! control structure for diagnostic purposes. - - if (associated(sfc_state%frazil)) then - fraz = sfc_state%frazil(i,j) * I_dt_LHF - if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz - !CS%lprec(i,j)=CS%lprec(i,j) - fraz - sfc_state%frazil(i,j) = 0.0 - endif - - !Alon: Should these be set to zero too? - if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 - if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 - endif - enddo ; enddo - endif - -end subroutine add_berg_flux_to_shelf - subroutine ocean_model_restart(OS, timestamp) - type(ocean_state_type), pointer :: OS - character(len=*), intent(in), optional :: timestamp + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state being saved to a restart file + character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be + !! prepended to the file name. (Currently this is unused.) if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& @@ -903,10 +800,11 @@ end subroutine ocean_model_save_restart subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & gas_fields_ocn) - type(domain2D), intent(in) :: input_domain + type(domain2D), intent(in) :: input_domain type(ocean_public_type), intent(inout) :: Ocean_sfc - type(diag_ctrl), intent(in) :: diag - logical, intent(in), optional :: maskmap(:,:) + type(diag_ctrl), intent(in) :: diag + logical, dimension(:,:), & + optional, intent(in) :: maskmap type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the !! ocean and surface-ice fields that will participate diff --git a/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 b/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 index 66b2463ae7..5494954398 100644 --- a/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 @@ -10,21 +10,23 @@ module atmos_ocean_fluxes_mod contains +!> This subroutine duplicates an interface used by the FMS coupler, but only +!! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & param, flag, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) - character(len=*), intent(in) :: name - character(len=*), intent(in) :: flux_type - character(len=*), intent(in) :: implementation - integer, intent(in), optional :: atm_tr_index - real, intent(in), dimension(:), optional :: param - logical, intent(in), dimension(:), optional :: flag - character(len=*), intent(in), optional :: ice_restart_file - character(len=*), intent(in), optional :: ocean_restart_file - character(len=*), intent(in), optional :: units - character(len=*), intent(in), optional :: caller - integer, intent(in), optional :: verbosity + character(len=*), intent(in) :: name !< An unused argument + character(len=*), intent(in) :: flux_type !< An unused argument + character(len=*), intent(in) :: implementation !< An unused argument + integer, optional, intent(in) :: atm_tr_index !< An unused argument + real, dimension(:), optional, intent(in) :: param !< An unused argument + logical, dimension(:), optional, intent(in) :: flag !< An unused argument + character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument + character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument + character(len=*), optional, intent(in) :: units !< An unused argument + character(len=*), optional, intent(in) :: caller !< An unused argument + integer, optional, intent(in) :: verbosity !< An unused argument ! None of these arguments are used for anything. diff --git a/config_src/ice_solo_driver/coupler_types.F90 b/config_src/ice_solo_driver/coupler_types.F90 index bc4a941b04..a57d2dd37e 100644 --- a/config_src/ice_solo_driver/coupler_types.F90 +++ b/config_src/ice_solo_driver/coupler_types.F90 @@ -294,7 +294,7 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' @@ -343,7 +343,7 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' @@ -386,7 +386,7 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' @@ -435,7 +435,7 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' @@ -478,7 +478,7 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' @@ -527,7 +527,7 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 35217b5c8e..354e309ed9 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1675,7 +1675,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices logical, intent(in) :: sw_decomp !< controls if shortwave is !!decomposed into four components - real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition ! local variables type(time_type) :: Master_time !< This allows step_MOM to temporarily change @@ -1769,8 +1769,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes, & - OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, S%restart_CSp) endif call disable_averaging(OS%diag) @@ -1813,21 +1812,21 @@ end subroutine update_ocean_model !! the future. subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, & c1, c2, c3, c4, restore_salt, restore_temp) - type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), intent(inout) :: fluxes !< Surface fluxes - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid - type(surface_forcing_CS), pointer :: CS !< control structure returned by - !! a previous call to surface_forcing_init - type(surface), intent(in) :: state !< control structure to ocean - !! surface state fields. - real(kind=8), intent(in) :: x2o_o(:,:)!< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are - !! restored + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), intent(inout) :: fluxes !< Surface fluxes + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid + type(surface_forcing_CS), pointer :: CS !< control structure returned by + !! a previous call to surface_forcing_init + type(surface), intent(in) :: state !< control structure to ocean + !! surface state fields. + real(kind=8), intent(in) :: x2o_o(:,:)!< Fluxes from coupler to ocean, computed by ocean + type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are + !! restored ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -1942,9 +1941,11 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, endif ! endif for allocation and initialization if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 endif + if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 + if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie @@ -2293,7 +2294,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, endif ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff enddo ; enddo do i=isd,ied ; do J=jsd,jed-1 mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth @@ -2302,7 +2303,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & (mass_ice + CS%rigid_sea_ice_mass) endif - forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff enddo ; enddo endif diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index c2ac628909..1bc713d106 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -496,7 +496,7 @@ program MOM_main endif if (ns==1) then - call finish_MOM_initialization(Time, dirs, MOM_CSp, fluxes, restart_CSp) + call finish_MOM_initialization(Time, dirs, MOM_CSp, restart_CSp) endif ! This call steps the model over a time dt_forcing. diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 66b2463ae7..5494954398 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -10,21 +10,23 @@ module atmos_ocean_fluxes_mod contains +!> This subroutine duplicates an interface used by the FMS coupler, but only +!! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & param, flag, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) - character(len=*), intent(in) :: name - character(len=*), intent(in) :: flux_type - character(len=*), intent(in) :: implementation - integer, intent(in), optional :: atm_tr_index - real, intent(in), dimension(:), optional :: param - logical, intent(in), dimension(:), optional :: flag - character(len=*), intent(in), optional :: ice_restart_file - character(len=*), intent(in), optional :: ocean_restart_file - character(len=*), intent(in), optional :: units - character(len=*), intent(in), optional :: caller - integer, intent(in), optional :: verbosity + character(len=*), intent(in) :: name !< An unused argument + character(len=*), intent(in) :: flux_type !< An unused argument + character(len=*), intent(in) :: implementation !< An unused argument + integer, optional, intent(in) :: atm_tr_index !< An unused argument + real, dimension(:), optional, intent(in) :: param !< An unused argument + logical, dimension(:), optional, intent(in) :: flag !< An unused argument + character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument + character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument + character(len=*), optional, intent(in) :: units !< An unused argument + character(len=*), optional, intent(in) :: caller !< An unused argument + integer, optional, intent(in) :: verbosity !< An unused argument ! None of these arguments are used for anything. diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index 819eac6de7..ba4ce0d3fa 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -68,7 +68,8 @@ module coupler_types_mod type, public :: coupler_3d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -115,7 +116,8 @@ module coupler_types_mod type, public :: coupler_2d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -156,7 +158,8 @@ module coupler_types_mod type, public :: coupler_1d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized end type coupler_1d_bc_type @@ -291,10 +294,11 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' @@ -340,10 +344,11 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' @@ -383,10 +388,11 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' @@ -432,10 +438,11 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' @@ -475,10 +482,11 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' @@ -524,10 +532,11 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' @@ -1174,8 +1183,10 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1249,8 +1260,10 @@ subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1329,8 +1342,10 @@ subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd @@ -1563,8 +1578,10 @@ subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1640,8 +1657,10 @@ subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1718,8 +1737,10 @@ subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1802,8 +1823,10 @@ subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1893,8 +1916,10 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1946,7 +1971,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then iow = 1 + (var_in%isc - var_in%isd) - var%isc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& + "of a computational or data domain.") endif if ((1+var%jec-var%jsc) == size(weights,2)) then jow = 1 - var%jsc @@ -1955,7 +1981,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& + "of a computational or data domain.") endif io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks @@ -2720,7 +2747,8 @@ end subroutine CT_set_data_3d !> This routine registers the diagnostics of a coupler_2d_bc_type. subroutine CT_set_diags_2d(var, diag_name, axes, time) type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field @@ -2746,7 +2774,8 @@ end subroutine CT_set_diags_2d !> This routine registers the diagnostics of a coupler_3d_bc_type. subroutine CT_set_diags_3d(var, diag_name, axes, time) type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 34ad978cd2..c39dbec562 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -295,7 +295,8 @@ end subroutine ALE_end subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure @@ -381,7 +382,8 @@ end subroutine ALE_main subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -514,7 +516,7 @@ end subroutine ALE_offline_inputs subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step (m or Pa) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after @@ -556,9 +558,10 @@ end subroutine ALE_offline_tracer_final !> Check grid for negative thicknesses subroutine check_grid( G, GV, h, threshold ) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the last time step (H units) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the + !! last time step (H units) real, intent(in) :: threshold !< Value below which to flag issues (H units) ! Local variables integer :: i, j @@ -586,7 +589,8 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h type(regridding_CS), intent(in) :: regridCS !< Regridding parameters and options type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variable structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) logical, optional, intent(in) :: debug !< If true, show the call tree real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage ! Local variables @@ -640,7 +644,8 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions - logical, optional, intent(in) :: initial !< Whether we're being called from an initialization routine (and expect diagnostics to work) + logical, optional, intent(in) :: initial !< Whether we're being called from an initialization + !! routine (and expect diagnostics to work) ! Local variables integer :: i, j, k, nz @@ -707,18 +712,21 @@ end subroutine ALE_regrid_accelerated !! remap initiali conditions to the model grid. It is also called during a !! time step to update the state. subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, dxInterface, u, v, debug, dt) - type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure - type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) - type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1),optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: u !< Zonal velocity component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), optional, intent(inout) :: v !< Meridional velocity component (m/s) - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure + type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) + type(tracer_registry_type), pointer :: Reg !< Tracer registry structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: u !< Zonal velocity component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + optional, intent(inout) :: v !< Meridional velocity component (m/s) + logical, optional, intent(in) :: debug !< If true, show the call tree + real, optional, intent(in) :: dt !< time step for diagnostics ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -740,8 +748,8 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dxInterface. Otherwise, ! u and v can be remapped without dxInterface if ( .not. present(dxInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm and u/v are to"// & - "be remapped") + call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm "// & + "and u/v are to be remapped") endif !### Try replacing both of these with GV%H_subroundoff diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 482909892b..d4fe0a0c38 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -41,7 +41,7 @@ module MOM_regridding !> This array is set by function setCoordinateResolution() !! It contains the "resolution" or delta coordinate of the target - !! coorindate. It has the units of the target coordiante, e.g. + !! coorindate. It has the units of the target coordinate, e.g. !! meters for z*, non-dimensional for sigma, etc. real, dimension(:), allocatable :: coordinateResolution @@ -530,7 +530,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then call get_param(param_file, mod, "ADAPT_TIME_RATIO", adaptTimeRatio, & - "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) + "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"? call get_param(param_file, mod, "ADAPT_ZOOM_DEPTH", adaptZoom, & "Depth of near-surface zooming region.", units="m", default=200.0) call get_param(param_file, mod, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & @@ -756,8 +756,7 @@ subroutine end_regridding(CS) end subroutine end_regridding !------------------------------------------------------------------------------ -! Dispatching regridding routine: regridding & remapping -!------------------------------------------------------------------------------ +!> Dispatching regridding routine for orchestrating regridding & remapping subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_shelf_h, conv_adjust) !------------------------------------------------------------------------------ ! This routine takes care of (1) building a new grid and (2) remapping between @@ -781,12 +780,13 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the last time step + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + !! the last time step type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variables (T, S, ...) real, dimension(SZI_(G),SZJ_(G), CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target coordinate real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in position of each interface - real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage - logical, optional, intent(in ) :: conv_adjust ! If true, do convective adjustment + real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage + logical, optional, intent(in ) :: conv_adjust !< If true, do convective adjustment ! Local variables real :: trickGnuCompiler logical :: use_ice_shelf @@ -1107,12 +1107,12 @@ end subroutine filtered_grid_motion subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) ! Arguments - type(regridding_CS), intent(in) :: CS !< Regridding control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. - real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage. + type(regridding_CS), intent(in) :: CS !< Regridding control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. + real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage. ! Local variables integer :: i, j, k integer :: nz @@ -1197,7 +1197,7 @@ end subroutine build_zstar_grid !------------------------------------------------------------------------------ ! Build sigma grid -!------------------------------------------------------------------------------ +!> This routine builds a grid based on terrain-following coordinates. subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) !------------------------------------------------------------------------------ ! This routine builds a grid based on terrain-following coordinates. @@ -1207,11 +1207,11 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) !------------------------------------------------------------------------------ ! Arguments - type(regridding_CS), intent(in) :: CS !< Regridding control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. + type(regridding_CS), intent(in) :: CS !< Regridding control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. ! Local variables integer :: i, j, k @@ -1275,6 +1275,7 @@ end subroutine build_sigma_grid !------------------------------------------------------------------------------ ! Build grid based on target interface densities !------------------------------------------------------------------------------ +!> This routine builds a new grid based on a given set of target interface densities. subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) !------------------------------------------------------------------------------ ! This routine builds a new grid based on a given set of target interface @@ -1405,13 +1406,13 @@ end subroutine build_rho_grid !! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88. !! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 } subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (H units) - real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (H units) + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position ! Local variables real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface in H units (m or kg m-2) @@ -1471,14 +1472,17 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) end subroutine build_grid_HyCOM1 +!> This subroutine builds an adaptive grid that follows density surfaces where +!! possible, subject to constraints on the smoothness of interface heights. subroutine build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface - type(remapping_CS), intent(in) :: remapCS - type(regridding_CS), intent(in) :: CS + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H + type(remapping_CS), intent(in) :: remapCS !< The remapping control structure + type(regridding_CS), intent(in) :: CS !< Regridding control structure ! local variables integer :: i, j, k, nz ! indices and dimension lengths @@ -1535,7 +1539,7 @@ end subroutine build_grid_adaptive !! shallow topography, this will tend to give a uniform sigma-like coordinate. !! For sufficiently shallow water, a minimum grid spacing is used to avoid !! certain instabilities. -subroutine build_grid_SLight( G, GV, h, tv, dzInterface, CS ) +subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units @@ -1637,9 +1641,11 @@ subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) endif do k = min(CS%nk,nk),2,-1 h_new = h_old(k) + ( dz_int(k) - dz_int(k+1) ) - if (h_new Achieve convective adjustment by swapping layers subroutine convective_adjustment(G, GV, h, tv) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables !------------------------------------------------------------------------------ ! Check each water column to see whether it is stratified. If not, sort the ! layers by successive swappings of water masses (bubble sort algorithm) !------------------------------------------------------------------------------ - ! Arguments - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables - ! Local variables integer :: i, j, k real :: T0, T1 ! temperatures @@ -1867,17 +1871,21 @@ end subroutine convective_adjustment !------------------------------------------------------------------------------ -! Return uniform resolution vector based on coordiante mode -!------------------------------------------------------------------------------ +!> Return a uniform resolution vector in the units of the coordinata function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) !------------------------------------------------------------------------------ ! Calculate a vector of uniform resolution in the units of the coordinate !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: nk - character(len=*), intent(in) :: coordMode - real, intent(in) :: maxDepth, rhoLight, rhoHeavy - real :: uniformResolution(nk) + integer, intent(in) :: nk !< Number of cells in source grid + character(len=*), intent(in) :: coordMode !< A string indicating the coordinate mode. + !! See the documenttion for regrid_consts + !! for the recognized values. + real, intent(in) :: maxDepth !< The range of the grid values in some modes + real, intent(in) :: rhoLight !< The minimum value of the grid in RHO mode + real, intent(in) :: rhoHeavy !< The maximum value of the grid in RHO mode + + real :: uniformResolution(nk) !< The returned uniform resolution grid. ! Local variables integer :: scheme @@ -1903,9 +1911,13 @@ function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) end function uniformResolution +!> Initialize the coordinate resolutions by calling the appropriate initialization +!! routine for the specified coordinate mode. subroutine initCoord(CS, coord_mode) - type(regridding_CS), intent(inout) :: CS - character(len=*), intent(in) :: coord_mode + type(regridding_CS), intent(inout) :: CS !< Regridding control structure + character(len=*), intent(in) :: coord_mode !< A string indicating the coordinate mode. + !! See the documenttion for regrid_consts + !! for the recognized values. select case (coordinateMode(coord_mode)) case (REGRIDDING_ZSTAR) @@ -1926,11 +1938,10 @@ subroutine initCoord(CS, coord_mode) end subroutine initCoord !------------------------------------------------------------------------------ -! Set the fixed resolution data -!------------------------------------------------------------------------------ +!> Set the fixed resolution data subroutine setCoordinateResolution( dz, CS ) - real, dimension(:), intent(in) :: dz - type(regridding_CS), intent(inout) :: CS + real, dimension(:), intent(in) :: dz !< A vector of vertical grid spacings + type(regridding_CS), intent(inout) :: CS !< Regridding control structure if (size(dz)/=CS%nk) call MOM_error( FATAL, & 'setCoordinateResolution: inconsistent number of levels' ) @@ -2036,10 +2047,9 @@ end subroutine set_regrid_max_thickness !------------------------------------------------------------------------------ -! Query the fixed resolution data -!------------------------------------------------------------------------------ +!> Query the fixed resolution data function getCoordinateResolution( CS ) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(CS%nk) :: getCoordinateResolution getCoordinateResolution(:) = CS%coordinateResolution(:) @@ -2075,10 +2085,9 @@ function getCoordinateInterfaces( CS ) end function getCoordinateInterfaces !------------------------------------------------------------------------------ -! Query the target coordinate units -!------------------------------------------------------------------------------ +!> Query the target coordinate units function getCoordinateUnits( CS ) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure character(len=20) :: getCoordinateUnits select case ( CS%regridding_scheme ) @@ -2100,10 +2109,9 @@ function getCoordinateUnits( CS ) end function getCoordinateUnits !------------------------------------------------------------------------------ -! Query the short name of the coordinate -!------------------------------------------------------------------------------ +!> Query the short name of the coordinate function getCoordinateShortName( CS ) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure character(len=20) :: getCoordinateShortName select case ( CS%regridding_scheme ) @@ -2149,14 +2157,25 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (m) integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickess layers at the top of the model - real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential density (m) - real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find resolved stratification (nondim) + real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential + !! density (m) + real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find + !! resolved stratification (nondim) logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate - real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for spuriously unstable water mass profiles (m) - real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic halocline region. - logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward from the top. - real, optional, intent(in) :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha - logical, optional, intent(in) :: adaptDoMin + real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for + !! spuriously unstable water mass profiles (m) + real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic + !! halocline region. + logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward + !! from the top. + real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale, ND. + real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in m. + real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity, ND. + real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity, ND. + real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency, ND. + logical, optional, intent(in) :: adaptDoMin !< If true, make a HyCOM-like mixed layer by + !! preventing interfaces from being shallower than + !! the depths specified by the regridding coordinate. if (present(interp_scheme)) call set_interp_scheme(CS%interp_CS, interp_scheme) if (present(boundary_extrapolation)) call set_interp_extrap(CS%interp_CS, boundary_extrapolation) @@ -2186,7 +2205,8 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(min_thickness)) call set_sigma_params(CS%sigma_CS, min_thickness=min_thickness) case (REGRIDDING_RHO) if (present(min_thickness)) call set_rho_params(CS%rho_CS, min_thickness=min_thickness) - if (present(integrate_downward_for_e)) call set_rho_params(CS%rho_CS, integrate_downward_for_e=integrate_downward_for_e) + if (present(integrate_downward_for_e)) & + call set_rho_params(CS%rho_CS, integrate_downward_for_e=integrate_downward_for_e) if (associated(CS%rho_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & call set_rho_params(CS%rho_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYCOM1) @@ -2223,35 +2243,37 @@ integer function get_regrid_size(CS) end function get_regrid_size +!> This returns a copy of the zlike_CS stored in the regridding control structure. function get_zlike_CS(CS) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(zlike_CS) :: get_zlike_CS get_zlike_CS = CS%zlike_CS end function get_zlike_CS +!> This returns a copy of the sigma_CS stored in the regridding control structure. function get_sigma_CS(CS) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(sigma_CS) :: get_sigma_CS get_sigma_CS = CS%sigma_CS end function get_sigma_CS +!> This returns a copy of the rho_CS stored in the regridding control structure. function get_rho_CS(CS) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(rho_CS) :: get_rho_CS get_rho_CS = CS%rho_CS end function get_rho_CS !------------------------------------------------------------------------------ -! Return coordinate-derived thicknesses for fixed coordinate systems -!------------------------------------------------------------------------------ +!> Return coordinate-derived thicknesses for fixed coordinate systems function getStaticThickness( CS, SSH, depth ) - type(regridding_CS), intent(in) :: CS - real, intent(in) :: SSH - real, intent(in) :: depth - real, dimension(CS%nk) :: getStaticThickness + type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, intent(in) :: SSH !< The sea surface height, in the same units as depth + real, intent(in) :: depth !< The maximum depth of the grid, perhaps in m. + real, dimension(CS%nk) :: getStaticThickness !< The returned thicknesses in the units of depth ! Local integer :: k real :: z, dz diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index a7879ae063..dee2e20bd8 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -224,9 +224,11 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_ed .or. (u1minu0max) ) then write(0,*) 'iMethod = ',iMethod write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min if (u1minh0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min if (u1minh0err+h2err) & + write(0,*) 'H non-conservation difference=',h2tot-h0tot,'allowed err=',h0err+h2err,' <-----!' + write(0,*) 'UH: u0tot=',u0tot,'u2tot=',u2tot,'duh=',u2tot-u0tot,'u0err=',u0err,'u2err=',u2err,& + 'adjustment err=',u02_err + if (abs(u2tot-u0tot)>u0err+u2err) & + write(0,*) 'U non-conservation difference=',u2tot-u0tot,'allowed err=',u0err+u2err,' <-----!' write(0,*) 'Sub-cells to target:' write(0,*) 'H: h2tot=',h2tot,'h1tot=',h1tot,'dh=',h1tot-h2tot,'h2err=',h2err,'h1err=',h1err - if (abs(h1tot-h2tot)>h2err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h2tot,'allowed err=',h2err+h1err,' <-----!' + if (abs(h1tot-h2tot)>h2err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h2tot,'allowed err=',h2err+h1err,' <-----!' write(0,*) 'UH: u2tot=',u2tot,'u1tot=',u1tot,'duh=',u1tot-u2tot,'u2err=',u2err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u2tot)>u2err+u1err) write(0,*) 'U non-conservation difference=',u1tot-u2tot,'allowed err=',u2err+u1err,' <-----!' + if (abs(u1tot-u2tot)>u2err+u1err) & + write(0,*) 'U non-conservation difference=',u1tot-u2tot,'allowed err=',u2err+u1err,' <-----!' write(0,*) 'Source to target:' write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min,'u2min=',u2min if (u1min Clean up the coordinate control structure subroutine end_coord_adapt(CS) - type(adapt_CS), pointer :: CS + type(adapt_CS), pointer :: CS !< The control structure for this module ! nothing to do if (.not. associated(CS)) return @@ -74,7 +74,7 @@ end subroutine end_coord_adapt subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff, & adaptBuoyCoeff, adaptDrho0, adaptDoMin) - type(adapt_CS), pointer :: CS + type(adapt_CS), pointer :: CS !< The control structure for this module real, optional, intent(in) :: adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff real, optional, intent(in) :: adaptBuoyCoeff, adaptDrho0 logical, optional, intent(in) :: adaptDoMin @@ -91,14 +91,17 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom end subroutine set_adapt_params subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) - type(adapt_CS), intent(in) :: CS + type(adapt_CS), intent(in) :: CS !< The control structure for this module type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - integer, intent(in) :: i, j - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt, tInt, sInt + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + integer, intent(in) :: i, j !< The indices of the column to work on + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H (m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZK_(GV)+1), intent(inout) :: zNext ! updated interface positions + real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions ! Local variables integer :: k, nz diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index ca68aa7b0b..41fb61f6c3 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -66,8 +66,10 @@ subroutine build_zstar_column(CS, depth, total_thickness, zInterface, & real, intent(in) :: depth !< Depth of ocean bottom (positive in m or H) real, intent(in) :: total_thickness !< Column thickness (positive in the same units as depth) real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces - real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the same units as depth) - real, optional, intent(in) :: eta_orig !< The actual original height of the top in the same units as depth + real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the + !! same units as depth) + real, optional, intent(in) :: eta_orig !< The actual original height of the top in the + !! same units as depth real, optional, intent(in) :: zScale !< Scaling factor from the target coordinate resolution !! in m to desired units for zInterface, perhaps m_to_H ! Local variables diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fe6f7073e6..a43a252e0a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -160,7 +160,7 @@ module MOM !! with a correction for the inverse barometer (meter) eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step (m or kg/m2) - real, pointer, dimension(:,:) :: & + real, dimension(:,:), pointer :: & Hml => NULL() !< active mixed layer depth, in m real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of @@ -241,7 +241,7 @@ module MOM type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics - real, pointer, dimension(:,:,:) :: & + real, dimension(:,:,:), pointer :: & h_pre_dyn => NULL(), & !< The thickness before the transports, in H. T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. S_pre_dyn => NULL() !< Salinity before the transports, in psu. @@ -249,7 +249,7 @@ module MOM !! for derived diagnostics (e.g., energy budgets) type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) - real, pointer, dimension(:,:,:) :: & + real, dimension(:,:,:), pointer :: & u_prev => NULL(), & !< previous value of u stored for diagnostics v_prev => NULL() !< previous value of v stored for diagnostics @@ -259,7 +259,7 @@ module MOM logical :: p_surf_prev_set !< If true, p_surf_prev has been properly set from !! a previous time-step or the ocean restart file. !! This is only valid when interp_p_surf is true. - real, pointer, dimension(:,:) :: & + real, dimension(:,:), pointer :: & p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... @@ -368,7 +368,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & end_cycle, cycle_length, reset_therm) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, + !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_interval !< time interval covered by this run segment, in s. @@ -392,8 +393,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !! If missing, this is like start_cycle. ! local - type(ocean_grid_type), pointer :: G ! pointer to a structure containing - ! metrics and related information + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() integer :: ntstep ! time steps between tracer updates or diabatic forcing @@ -431,11 +432,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & ssh ! sea surface height, which may be based on eta_av (meter) - real, pointer, dimension(:,:,:) :: & - u, & ! u : zonal velocity component (m/s) - v, & ! v : meridional velocity component (m/s) - h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real, pointer, dimension(:,:) :: & + real, dimension(:,:,:), pointer :: & + u => NULL(), & ! u : zonal velocity component (m/s) + v => NULL(), & ! v : meridional velocity component (m/s) + h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure, in Pa. real :: I_wt_ssh @@ -515,6 +516,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & dt = time_interval / real(n_max) dt_therm = dt ; ntstep = 1 if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf + + if (CS%UseWaves) call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass) endif if (therm_reset) then @@ -553,6 +556,16 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & else CS%p_surf_end => forces%p_surf endif + + if (CS%UseWaves) then + ! Update wave information, which is presently kept static over each call to step_mom + call enable_averaging(time_interval, Time_start + set_time(int(floor(time_interval+0.5))), CS%diag) + call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) + call disable_averaging(CS%diag) + endif + else ! not do_dyn. + if (CS%UseWaves) & ! Diagnostics are not enabled in this call. + call Update_Stokes_Drift(G, GV, Waves, h, fluxes%ustar) endif if (CS%debug) then @@ -572,16 +585,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Set the local time to the end of the time step. Time_local = Time_start + set_time(int(floor(rel_time+0.5))) - !### Update_Stokes_Drift must be behind a do_dyn or a do_thermo test. - if (CS%UseWaves) then - ! Update wave information, which is presently kept static over each call to step_mom - !bgr 3/15/18: Need to enable_averaging here to enable output of Stokes drift from the - ! update_stokes_drift routine. Other options? - call enable_averaging(dt, Time_local, CS%diag) - call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) - call disable_averaging(CS%diag) - endif - if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) !=========================================================================== @@ -603,13 +606,15 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & dtdia = dt*min(ntstep,n_max-(n-1)) endif - ! If necessary, temporarily reset CS%Time to the center of the period covered - ! by the call to step_MOM_thermo, noting that they begin at the same time. - if (dtdia > dt) CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) - - ! The end-time of the diagnostic interval needs to be set ahead if there - ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + end_time_thermo = Time_local + if (dtdia > dt) then + ! If necessary, temporarily reset CS%Time to the center of the period covered + ! by the call to step_MOM_thermo, noting that they begin at the same time. + CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + ! The end-time of the diagnostic interval needs to be set ahead if there + ! are multiple dynamic time steps worth of thermodynamics applied here. + end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + endif ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -843,20 +848,20 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & !! bottom boundary layer properties will apply, !! in s, or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM - type(time_type), intent(in) :: Time_local !< Starting time of a segment, as a time type + type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave related parameters; the - !! fields in Waves are intent(in) here. + !! fields in Waves are intent in here. ! local - type(ocean_grid_type), pointer :: G ! pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. - real, pointer, dimension(:,:,:) :: & - u, & ! u : zonal velocity component (m/s) - v, & ! v : meridional velocity component (m/s) - h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real, dimension(:,:,:), pointer :: & + u => NULL(), & ! u : zonal velocity component (m/s) + v => NULL(), & ! v : meridional velocity component (m/s) + h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -877,7 +882,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo,Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) + call enable_averaging(dt_thermo, Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -896,7 +901,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local+set_time(int(bbl_time_int-dt+0.5)), CS%diag) + Time_local + set_time(int(bbl_time_int-dt+0.5)), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, & @@ -913,7 +918,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & calc_dtbt = .false. if (CS%dtbt_reset_period == 0.0) calc_dtbt = .true. if (CS%dtbt_reset_period > 0.0) then - if (Time_local >= CS%dtbt_reset_time) then + if (Time_local >= CS%dtbt_reset_time) then !### Change >= to > here. calc_dtbt = .true. CS%dtbt_reset_time = CS%dtbt_reset_time + CS%dtbt_reset_interval endif @@ -1095,7 +1100,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave related parameters; - !! the fields in Waves are intent(in) here. + !! the fields in Waves are intent in here. logical :: use_ice_shelf ! Needed for selecting the right ALE interface. logical :: showCallTree @@ -1275,15 +1280,15 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS logical :: skip_diffusion integer :: id_eta_diff_end - integer, pointer :: accumulated_time + integer, pointer :: accumulated_time => NULL() integer :: i,j,k integer :: is, ie, js, je, isd, ied, jsd, jed ! 3D pointers - real, dimension(:,:,:), pointer :: & - uhtr, vhtr, & - eatr, ebtr, & - h_end + real, dimension(:,:,:), pointer :: & + uhtr => NULL(), vhtr => NULL(), & + eatr => NULL(), ebtr => NULL(), & + h_end => NULL() ! 2D Array for diagnostics real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end @@ -1348,7 +1353,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Perform offline diffusion if requested if (.not. skip_diffusion) then if (associated(CS%VarMix)) then - call pass_var(CS%h,G%Domain) + call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) endif @@ -1373,7 +1378,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Perform offline diffusion if requested if (.not. skip_diffusion) then if (associated(CS%VarMix)) then - call pass_var(CS%h,G%Domain) + call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) endif @@ -1429,9 +1434,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call extract_surface_state(CS, sfc_state) call disable_averaging(CS%diag) - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) - call pass_var(CS%h,G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) + call pass_var(CS%h, G%Domain) fluxes%fluxes_used = .true. @@ -1468,7 +1473,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(hor_index_type) :: HI ! A hor_index_type for array extents type(verticalGrid_type), pointer :: GV => NULL() type(dyn_horgrid_type), pointer :: dG => NULL() - type(diag_ctrl), pointer :: diag + type(diag_ctrl), pointer :: diag => NULL() character(len=4), parameter :: vers_num = 'v2.0' @@ -1484,7 +1489,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real, allocatable, dimension(:,:) :: eta ! free surface height (m) or bottom press (Pa) real, allocatable, dimension(:,:) :: area_shelf_h ! area occupied by ice shelf real, dimension(:,:), allocatable, target :: frac_shelf_h ! fraction of total area occupied by ice shelf - real, dimension(:,:), pointer :: shelf_area + real, dimension(:,:), pointer :: shelf_area => NULL() type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h ! GMM, the following *is not* used. Should we delete it? @@ -2399,11 +2404,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & end subroutine initialize_MOM !> This subroutine finishes initializing MOM and writes out the initial conditions. -subroutine finish_MOM_initialization(Time, dirs, CS, fluxes, restart_CSp) +subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths type(MOM_control_struct), pointer :: CS !< pointer to MOM control structure - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control !! structure that will be used for MOM. ! Local variables @@ -2614,11 +2618,11 @@ subroutine extract_surface_state(CS, sfc_state) real :: hu, hv type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - real, pointer, dimension(:,:,:) :: & - u, & ! u : zonal velocity component (m/s) - v, & ! v : meridional velocity component (m/s) - h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + type(verticalGrid_type), pointer :: GV => NULL() + real, dimension(:,:,:), pointer :: & + u => NULL(), & ! u : zonal velocity component (m/s) + v => NULL(), & ! v : meridional velocity component (m/s) + h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) real :: depth(SZI_(CS%G)) ! distance from the surface (meter) real :: depth_ml ! depth over which to average to ! determine mixed layer properties (meter) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 7f67757d3e..62bd140255 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -44,18 +44,26 @@ module MOM_PressureForce !> A thin layer between the model and the Boussinesq and non-Boussinesq pressure force routines. subroutine PressureForce(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv - type(PressureForce_CS), pointer :: CS - type(ALE_CS), pointer :: ALE_CSp - real, dimension(:,:), optional, pointer :: p_atm - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta - + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: PFu !< Zonal pressure force acceleration (m/s2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: PFv !< Meridional pressure force acceleration (m/s2) + type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure + real, dimension(:,:), & + optional, pointer :: p_atm !< The pressure at the ice-ocean or + !! atmosphere-ocean interface in Pa. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer + !! due to eta anomalies, in m2 s-2 H-1. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, + !! in H, with any tidal contributions. if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 147f264cc3..a30f8e9974 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -31,12 +31,12 @@ module MOM_PressureForce_Mont real :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. !! Usually this ratio is 1. - type(time_type), pointer :: Time ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() ! Accelerations due to pressure - real, pointer :: PFv_bc(:,:,:) => NULL() ! gradients deriving from density - ! gradients within layers, m s-2. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate + !! the timing of diagnostic output. + real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure + real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density + !! gradients within layers, m s-2. integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 type(tidal_forcing_CS), pointer :: tides_CSp => NULL() end type PressureForce_Mont_CS @@ -63,12 +63,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) in m/s2. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or + real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean in Pa. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, !! in m2 s-2 H-1. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) , in m2 s-2. @@ -616,19 +618,21 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in H. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface - !! and the gravitational acceleration of the planet. - !! Usually this ratio is 1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due - !! to free surface height anomalies, in m2 H-1 s-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: rho_star !< The layer densities (maybe - !! compressibility compensated), times g/rho_0, in m s-2. + !! and the gravitational acceleration of the planet. + !! Usually this ratio is 1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due + !! to free surface height anomalies, in m2 H-1 s-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: rho_star !< The layer densities (maybe compressibility + !! compensated), times g/rho_0, in m s-2. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer ! thicknesses, in m-1. @@ -902,7 +906,7 @@ end subroutine PressureForce_Mont_init !> Deallocates the Montgomery-potential form of PGF control structure subroutine PressureForce_Mont_end(CS) - type(PressureForce_Mont_CS), pointer :: CS + type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF if (associated(CS)) deallocate(CS) end subroutine PressureForce_Mont_end diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5b5ab92869..63f271089e 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -162,172 +162,172 @@ module MOM_barotropic ! frhatu and frhatv are the fraction of the total column thickness ! interpolated to u or v grid points in each layer, nondimensional. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - IDatu, & ! Inverse of the basin depth at u grid points, in m-1. - lin_drag_u, & ! A spatially varying linear drag coefficient acting - ! on the zonal barotropic flow, in H s-1. - uhbt_IC, & ! The barotropic solver's estimate of the zonal - ! transport as the initial condition for the next call - ! to btstep, in H m2 s-1. - ubt_IC, & ! The barotropic solver's estimate of the zonal velocity - ! that will be the initial condition for the next call - ! to btstep, in m s-1. - ubtav ! The barotropic zonal velocity averaged over the - ! baroclinic time step, m s-1. + IDatu, & !< Inverse of the basin depth at u grid points, in m-1. + lin_drag_u, & !< A spatially varying linear drag coefficient acting + !! on the zonal barotropic flow, in H s-1. + uhbt_IC, & !< The barotropic solver's estimate of the zonal + !! transport as the initial condition for the next call + !! to btstep, in H m2 s-1. + ubt_IC, & !< The barotropic solver's estimate of the zonal velocity + !! that will be the initial condition for the next call + !! to btstep, in m s-1. + ubtav !< The barotropic zonal velocity averaged over the + !! baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - IDatv, & ! Inverse of the basin depth at v grid points, in m-1. - lin_drag_v, & ! A spatially varying linear drag coefficient acting - ! on the zonal barotropic flow, in H s-1. - vhbt_IC, & ! The barotropic solver's estimate of the zonal - ! transport as the initla condition for the next call - ! to btstep, in H m2 s-1. - vbt_IC, & ! The barotropic solver's estimate of the zonal velocity - ! that will be the initial condition for the next call - ! to btstep, in m s-1. - vbtav ! The barotropic meridional velocity averaged over the - ! baroclinic time step, m s-1. + IDatv, & !< Inverse of the basin depth at v grid points, in m-1. + lin_drag_v, & !< A spatially varying linear drag coefficient acting + !! on the zonal barotropic flow, in H s-1. + vhbt_IC, & !< The barotropic solver's estimate of the zonal + !! transport as the initla condition for the next call + !! to btstep, in H m2 s-1. + vbt_IC, & !< The barotropic solver's estimate of the zonal velocity + !! that will be the initial condition for the next call + !! to btstep, in m s-1. + vbtav !< The barotropic meridional velocity averaged over the + !! baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - eta_cor, & ! The difference between the free surface height from - ! the barotropic calculation and the sum of the layer - ! thicknesses. This difference is imposed as a forcing - ! term in the barotropic calculation over a baroclinic - ! timestep, in H (m or kg m-2). - eta_cor_bound ! A limit on the rate at which eta_cor can be applied - ! while avoiding instability, in units of H s-1. This - ! is only used if CS%bound_BT_corr is true. + eta_cor, & !< The difference between the free surface height from + !! the barotropic calculation and the sum of the layer + !! thicknesses. This difference is imposed as a forcing + !! term in the barotropic calculation over a baroclinic + !! timestep, in H (m or kg m-2). + eta_cor_bound !< A limit on the rate at which eta_cor can be applied + !! while avoiding instability, in units of H s-1. This + !! is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & - ua_polarity, & ! Test vector components for checking grid polarity. - va_polarity, & ! Test vector components for checking grid polarity. - bathyT ! A copy of bathyT (ocean bottom depth) with wide halos. + ua_polarity, & !< Test vector components for checking grid polarity. + va_polarity, & !< Test vector components for checking grid polarity. + bathyT !< A copy of bathyT (ocean bottom depth) with wide halos. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & - IareaT ! This is a copy of G%IareaT with wide halos, but will - ! still utilize the macro IareaT when referenced, m-2. + IareaT !< This is a copy of G%IareaT with wide halos, but will + !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & ! A simply averaged depth at u points, in m. - dy_Cu, & ! A copy of G%dy_Cu with wide halos, in m. - IdxCu ! A copy of G%IdxCu with wide halos, in m-1. + D_u_Cor, & !< A simply averaged depth at u points, in m. + dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. + IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & ! A simply averaged depth at v points, in m. - dx_Cv, & ! A copy of G%dx_Cv with wide halos, in m. - IdyCv ! A copy of G%IdyCv with wide halos, in m-1. + D_v_Cor, & !< A simply averaged depth at v points, in m. + dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. + IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D ! f / D at PV points, in m-1 s-1. + q_D !< f / D at PV points, in m-1 s-1. - real, pointer, dimension(:,:,:) :: frhatu1 => NULL(), frhatv1 => NULL() ! Predictor values. + real, dimension(:,:,:), pointer :: frhatu1 => NULL(), frhatv1 => NULL() ! Predictor values. type(BT_OBC_type) :: BT_OBC !< A structure with all of this module's fields !! for applying open boundary conditions. - real :: Rho0 ! The density used in the Boussinesq - ! approximation, in kg m-3. - real :: dtbt ! The barotropic time step, in s. - real :: dtbt_fraction ! The fraction of the maximum time-step that - ! should used. The default is 0.98. - real :: dtbt_max ! The maximum stable barotropic time step, in s. - real :: dt_bt_filter ! The time-scale over which the barotropic mode - ! solutions are filtered, in s. This can never - ! be taken to be longer than 2*dt. The default, 0, - ! applies no filtering. - integer :: nstep_last = 0 ! The number of barotropic timesteps per baroclinic - ! time step the last time btstep was called. - real :: bebt ! A nondimensional number, from 0 to 1, that - ! determines the gravity wave time stepping scheme. - ! 0.0 gives a forward-backward scheme, while 1.0 - ! give backward Euler. In practice, bebt should be - ! of order 0.2 or greater. - logical :: split ! If true, use the split time stepping scheme. - logical :: bound_BT_corr ! If true, the magnitude of the fake mass source - ! in the barotropic equation that drives the two - ! estimates of the free surface height toward each - ! other is bounded to avoid driving corrective - ! velocities that exceed MAXCFL_BT_CONT. - logical :: gradual_BT_ICs ! If true, adjust the initial conditions for the - ! barotropic solver to the values from the layered - ! solution over a whole timestep instead of - ! instantly. This is a decent approximation to the - ! inclusion of sum(u dh_dt) while also correcting - ! for truncation errors. - logical :: Sadourny ! If true, the Coriolis terms are discretized - ! with Sadourny's energy conserving scheme, - ! otherwise the Arakawa & Hsu scheme is used. If - ! the deformation radius is not resolved Sadourny's - ! scheme should probably be used. - logical :: Nonlinear_continuity ! If true, the barotropic continuity equation - ! uses the full ocean thickness for transport. - integer :: Nonlin_cont_update_period ! The number of barotropic time steps - ! between updates to the face area, or 0 only to - ! update at the start of a call to btstep. The - ! default is 1. - logical :: BT_project_velocity ! If true, step the barotropic velocity first - ! and project out the velocity tendancy by 1+BEBT - ! when calculating the transport. The default - ! (false) is to use a predictor continuity step to - ! find the pressure field, and then do a corrector - ! continuity step using a weighted average of the - ! old and new velocities, with weights of (1-BEBT) - ! and BEBT. - logical :: dynamic_psurf ! If true, add a dynamic pressure due to a viscous - ! ice shelf, for instance. - real :: Dmin_dyn_psurf ! The minimum depth to use in limiting the size - ! of the dynamic surface pressure for stability, - ! in m. - real :: ice_strength_length ! The length scale at which the damping rate - ! due to the ice strength should be the same as if - ! a Laplacian were applied, in m. - real :: const_dyn_psurf ! The constant that scales the dynamic surface - ! pressure, nondim. Stable values are < ~1.0. - ! The default is 0.9. - logical :: tides ! If true, apply tidal momentum forcing. - real :: G_extra ! A nondimensional factor by which gtot is enhanced. - integer :: hvel_scheme ! An integer indicating how the thicknesses at - ! velocity points are calculated. Valid values are - ! given by the parameters defined below: - ! HARMONIC, ARITHMETIC, HYBRID, and FROM_BT_CONT - logical :: strong_drag ! If true, use a stronger estimate of the retarding - ! effects of strong bottom drag. - logical :: linear_wave_drag ! If true, apply a linear drag to the barotropic - ! velocities, using rates set by lin_drag_u & _v - ! divided by the depth of the ocean. - logical :: linearized_BT_PV ! If true, the PV and interface thicknesses used - ! in the barotropic Coriolis calculation is time - ! invariant and linearized. - logical :: use_wide_halos ! If true, use wide halos and march in during the - ! barotropic time stepping for efficiency. - logical :: clip_velocity ! If true, limit any velocity components that are - ! are large enough for a CFL number to exceed - ! CFL_trunc. This should only be used as a - ! desperate debugging measure. - logical :: debug ! If true, write verbose checksums for debugging purposes. - logical :: debug_bt ! If true, write verbose checksums for debugging purposes. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: dtbt !< The barotropic time step, in s. + real :: dtbt_fraction !< The fraction of the maximum time-step that + !! should used. The default is 0.98. + real :: dtbt_max !< The maximum stable barotropic time step, in s. + real :: dt_bt_filter !< The time-scale over which the barotropic mode + !! solutions are filtered, in s. This can never + !! be taken to be longer than 2*dt. The default, 0, + !! applies no filtering. + integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic + !! time step the last time btstep was called. + real :: bebt !< A nondimensional number, from 0 to 1, that + !! determines the gravity wave time stepping scheme. + !! 0.0 gives a forward-backward scheme, while 1.0 + !! give backward Euler. In practice, bebt should be + !! of order 0.2 or greater. + logical :: split !< If true, use the split time stepping scheme. + logical :: bound_BT_corr !< If true, the magnitude of the fake mass source + !! in the barotropic equation that drives the two + !! estimates of the free surface height toward each + !! other is bounded to avoid driving corrective + !! velocities that exceed MAXCFL_BT_CONT. + logical :: gradual_BT_ICs !< If true, adjust the initial conditions for the + !! barotropic solver to the values from the layered + !! solution over a whole timestep instead of + !! instantly. This is a decent approximation to the + !! inclusion of sum(u dh_dt) while also correcting + !! for truncation errors. + logical :: Sadourny !< If true, the Coriolis terms are discretized + !! with Sadourny's energy conserving scheme, + !! otherwise the Arakawa & Hsu scheme is used. If + !! the deformation radius is not resolved Sadourny's + !! scheme should probably be used. + logical :: Nonlinear_continuity !< If true, the barotropic continuity equation + !! uses the full ocean thickness for transport. + integer :: Nonlin_cont_update_period !< The number of barotropic time steps + !! between updates to the face area, or 0 only to + !! update at the start of a call to btstep. The + !! default is 1. + logical :: BT_project_velocity !< If true, step the barotropic velocity first + !! and project out the velocity tendancy by 1+BEBT + !! when calculating the transport. The default + !! (false) is to use a predictor continuity step to + !! find the pressure field, and then do a corrector + !! continuity step using a weighted average of the + !! old and new velocities, with weights of (1-BEBT) + !! and BEBT. + logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous + !! ice shelf, for instance. + real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size + !! of the dynamic surface pressure for stability, + !! in m. + real :: ice_strength_length !< The length scale at which the damping rate + !! due to the ice strength should be the same as if + !! a Laplacian were applied, in m. + real :: const_dyn_psurf !< The constant that scales the dynamic surface + !! pressure, nondim. Stable values are < ~1.0. + !! The default is 0.9. + logical :: tides !< If true, apply tidal momentum forcing. + real :: G_extra !< A nondimensional factor by which gtot is enhanced. + integer :: hvel_scheme !< An integer indicating how the thicknesses at + !! velocity points are calculated. Valid values are + !! given by the parameters defined below: + !! HARMONIC, ARITHMETIC, HYBRID, and FROM_BT_CONT + logical :: strong_drag !< If true, use a stronger estimate of the retarding + !! effects of strong bottom drag. + logical :: linear_wave_drag !< If true, apply a linear drag to the barotropic + !! velocities, using rates set by lin_drag_u & _v + !! divided by the depth of the ocean. + logical :: linearized_BT_PV !< If true, the PV and interface thicknesses used + !! in the barotropic Coriolis calculation is time + !! invariant and linearized. + logical :: use_wide_halos !< If true, use wide halos and march in during the + !! barotropic time stepping for efficiency. + logical :: clip_velocity !< If true, limit any velocity components that are + !! are large enough for a CFL number to exceed + !! CFL_trunc. This should only be used as a + !! desperate debugging measure. + logical :: debug !< If true, write verbose checksums for debugging purposes. + logical :: debug_bt !< If true, write verbose checksums for debugging purposes. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0, in m s-1. - real :: maxvel ! Velocity components greater than maxvel are - ! truncated to maxvel, in m s-1. - real :: CFL_trunc ! If clip_velocity is true, velocity components will - ! be truncated when they are large enough that the - ! corresponding CFL number exceeds this value, nondim. - real :: maxCFL_BT_cont ! The maximum permitted CFL number associated with the - ! barotropic accelerations from the summed velocities - ! times the time-derivatives of thicknesses. The - ! default is 0.1, and there will probably be real - ! problems if this were set close to 1. - logical :: BT_cont_bounds ! If true, use the BT_cont_type variables to set - ! limits on the magnitude of the corrective mass - ! fluxes. - logical :: visc_rem_u_uh0 ! If true, use the viscous remnants when estimating - ! the barotropic velocities that were used to - ! calculate uh0 and vh0. False is probably the - ! better choice. - logical :: adjust_BT_cont ! If true, adjust the curve fit to the BT_cont type - ! that is used by the barotropic solver to match the - ! transport about which the flow is being linearized. + real :: maxvel !< Velocity components greater than maxvel are + !! truncated to maxvel, in m s-1. + real :: CFL_trunc !< If clip_velocity is true, velocity components will + !! be truncated when they are large enough that the + !! corresponding CFL number exceeds this value, nondim. + real :: maxCFL_BT_cont !< The maximum permitted CFL number associated with the + !! barotropic accelerations from the summed velocities + !! times the time-derivatives of thicknesses. The + !! default is 0.1, and there will probably be real + !! problems if this were set close to 1. + logical :: BT_cont_bounds !< If true, use the BT_cont_type variables to set + !! limits on the magnitude of the corrective mass + !! fluxes. + logical :: visc_rem_u_uh0 !< If true, use the viscous remnants when estimating + !! the barotropic velocities that were used to + !! calculate uh0 and vh0. False is probably the + !! better choice. + logical :: adjust_BT_cont !< If true, adjust the curve fit to the BT_cont type + !! that is used by the barotropic solver to match the + !! transport about which the flow is being linearized. logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations !! that is not bitwise rotationally symmetric in the !! meridional Coriolis term of the barotropic solver. - type(time_type), pointer :: Time ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate + !! the timing of diagnostic output. type(MOM_domain_type), pointer :: BT_Domain => NULL() - type(hor_index_type), pointer :: debug_BT_HI ! debugging copy of horizontal index_type + type(hor_index_type), pointer :: debug_BT_HI => NULL() !< debugging copy of horizontal index_type type(tidal_forcing_CS), pointer :: tides_CSp => NULL() logical :: module_is_initialized = .false. @@ -448,21 +448,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & !! viscosity is applied, in the zonal direction. Nondimensional !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction. - real, dimension(SZI_(G),SZJ_(G)), intent(out), optional :: etaav !< The free surface height or column mass + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass !! averaged over the barotropic integration, in m or kg m-2. - type(ocean_OBC_type), pointer, optional :: OBC !< The open boundary condition structure. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements that describe + type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic !! flow. - real, dimension(:,:), pointer, optional :: eta_PF_start !< The eta field consistent with the pressure + real, dimension(:,:), optional, pointer :: eta_PF_start !< The eta field consistent with the pressure !! gradient at the start of the barotropic stepping, in m or !! kg m-2. - real, dimension(:,:), pointer, optional :: taux_bot !< The zonal bottom frictional stress from + real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from !! ocean to the seafloor, in Pa. - real, dimension(:,:), pointer, optional :: tauy_bot !< The meridional bottom frictional stress + real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor, in Pa. - real, dimension(:,:,:), pointer, optional :: uh0, u_uh0 - real, dimension(:,:,:), pointer, optional :: vh0, v_vh0 + real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference + !! velocities, in H m s-1. + real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0, in m s-1 + real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference + !! velocities, in H m s-1. + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0, in m s-1 ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -554,7 +558,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & eta, & ! The barotropic free surface height anomaly or column mass ! anomaly, in H (m or kg m-2) eta_pred ! A predictor value of eta, in H (m or kg m-2) like eta. - real, pointer, dimension(:,:) :: & + real, dimension(:,:), pointer :: & eta_PF_BT ! A pointer to the eta array (either eta or eta_pred) that ! determines the barotropic pressure force, in H (m or kg m-2) real, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -1422,7 +1426,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%ice_strength_length**2 * dtbt) ! Units of dyn_coef: m2 s-2 H-1 - dyn_coef_eta(I,j) = min(dyn_coef_max, ice_strength * GV%H_to_m) + dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_m) enddo ; enddo ; endif endif @@ -1627,7 +1631,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & if (CS%dynamic_psurf) then !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 - p_surf_dyn(i,j) = dyn_coef_eta(I,j) * (eta_pred(i,j) - eta(i,j)) + p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j)) enddo ; enddo endif endif @@ -2277,22 +2281,24 @@ end subroutine btstep !> This subroutine automatically determines an optimal value for dtbt based !! on some state of the ocean. subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(barotropic_CS), pointer :: CS !< Barotropic control structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in), optional :: eta !< The barotropic free surface height - !! anomaly or column mass anomaly, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: pbce !< The baroclinic pressure anomaly in each - !! layer due to free surface height - !! anomalies, in m2 H-1 s-2. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements that describe - !! the effective open face areas as a - !! function of barotropic flow. - real, intent(in), optional :: gtot_est !< An estimate of the total gravitational - !! acceleration, in m s-2. - real, intent(in), optional :: SSH_add !< An additional contribution to SSH to - !! provide a margin of error when - !! calculating the external wave speed, in m. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(barotropic_CS), pointer :: CS !< Barotropic control structure. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: eta !< The barotropic free surface height + !! anomaly or column mass anomaly, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each + !! layer due to free surface height + !! anomalies, in m2 H-1 s-2. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe + !! the effective open face areas as a + !! function of barotropic flow. + real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational + !! acceleration, in m s-2. + real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to + !! provide a margin of error when + !! calculating the external wave speed, in m. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -2304,10 +2310,10 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! (See Hallberg, J Comp Phys 1997 for a discussion.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing, in m2. + ! spacing, in H m. real, dimension(SZI_(G),SZJBS_(G)) :: & Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing, in m2. + ! spacing, in H m. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -2421,16 +2427,22 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, + !! in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, + !! in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used !! for a dynamic estimate of the face areas at !! v-points. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that + !! the barotropic functions agree with the sum + !! of the layer transpotts, in H m2 s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that + !! the barotropic functions agree with the sum + !! of the layer transpotts, in H m2 s-1. ! Local variables real :: vel_prev ! The previous velocity in m s-1. @@ -2687,8 +2699,10 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co integer, intent(in) :: halo !< The extra halo size to use here. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at u points. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, + !! in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, + !! in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2877,22 +2891,25 @@ end subroutine destroy_BT_OBC !! that will drive the barotropic estimate of the free surface height toward the !! baroclinic estimate. subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: h_u !< The specified thicknesses at u-points, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: h_v !< The specified thicknesses at v-points, - !! in m or kg m-2. - logical, intent(in), optional :: may_use_default !< An optional logical argument - !! to indicate that the default velocity point - !! thickesses may be used for this particular - !! calculation, even though the setting of - !! CS%hvel_scheme would usually require that h_u - !! and h_v be passed in. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundary control structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + type(barotropic_CS), pointer :: CS !< The control structure returned by a previous + !! call to barotropic_init. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: h_u !< The specified thicknesses at u-points, + !! in m or kg m-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: h_v !< The specified thicknesses at v-points, + !! in m or kg m-2. + logical, optional, intent(in) :: may_use_default !< An optional logical argument + !! to indicate that the default velocity point + !! thickesses may be used for this particular + !! calculation, even though the setting of + !! CS%hvel_scheme would usually require that h_u + !! and h_v be passed in. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure. ! Local variables ! All of these variables are in the same units as h - usually m or kg m-2. @@ -3148,7 +3165,10 @@ end subroutine btcalc !> The function find_uhbt determines the zonal transport for a given velocity. function find_uhbt(u, BTC) result(uhbt) real, intent(in) :: u !< The local zonal velocity, in m s-1 - type(local_BT_cont_u_type), intent(in) :: BTC + type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that + !! allow the barotropic transports to be calculated consistently + !! with the layers' continuity equations. + real :: uhbt !< The result if (u == 0.0) then @@ -3259,7 +3279,9 @@ end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity. function find_vhbt(v, BTC) result(vhbt) real, intent(in) :: v !< The local meridional velocity, in m s-1 - type(local_BT_cont_v_type), intent(in) :: BTC + type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that + !! allow the barotropic transports to be calculated consistently + !! with the layers' continuity equations. real :: vhbt !< The result if (v == 0.0) then @@ -3592,15 +3614,18 @@ end subroutine adjust_local_BT_cont_types !> This subroutine uses the BTCL types to find typical or maximum face !! areas, which can then be used for finding wave speeds, etc. subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) - type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the - !! barotropic solver. - type(memory_size_type), intent(in) :: MS !< A type that describes the memory - !! sizes of the argument arrays. - real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), intent(out) :: Datu - real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), intent(out) :: Datv - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: halo !< The extra halo size to use here. - logical, optional, intent(in) :: maximize + type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the + !! barotropic solver. + type(memory_size_type), intent(in) :: MS !< A type that describes the memory + !! sizes of the argument arrays. + real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & + intent(out) :: Datu !< The effective zonal face area, in H m. + real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & + intent(out) :: Datv !< The effective meridional face area, in H m. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: halo !< The extra halo size to use here. + logical, optional, intent(in) :: maximize !< If present and true, find the + !! maximum face area for any velocity. ! Local variables logical :: find_max @@ -3629,8 +3654,9 @@ subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) end subroutine BT_cont_to_face_areas +!> Swap the values of two real variables subroutine swap(a,b) - real, intent(inout) :: a, b + real, intent(inout) :: a, b !< The varaibles to be swapped. real :: tmp tmp = a ; a = b ; b = tmp end subroutine swap @@ -3638,24 +3664,21 @@ end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) - type(memory_size_type), intent(in) :: MS -! (in) MS - A type that describes the memory sizes of the argument arrays. - real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), intent(out) :: Datu !< The open zonal face area, - !! in H m (m2 or kg m-1). - real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), intent(out) :: Datv !< The open meridional face area, - !! in H m (m2 or kg m-1). - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. - real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), optional, intent(in) :: eta !< The barotropic free surface - !! height anomaly or column mass - !! anomaly, in H (m or kg m-2). - integer, optional, intent(in) :: halo !< The halo size to use, default = 1. - real, optional, intent(in) :: add_max !< A value to add to the maximum - !! depth (used to overestimate the - !! external wave speed) in m. - + type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. + real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & + intent(out) :: Datu !< The open zonal face area, in H m (m2 or kg m-1). + real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & + intent(out) :: Datv !< The open meridional face area, in H m (m2 or kg m-1). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(barotropic_CS), pointer :: CS !< The control structure returned by a previous + !! call to barotropic_init. + real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & + optional, intent(in) :: eta !< The barotropic free surface height anomaly + !! or column mass anomaly, in H (m or kg m-2). + integer, optional, intent(in) :: halo !< The halo size to use, default = 1. + real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used + !! to overestimate the external wave speed) in m. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3832,7 +3855,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & #include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. - real :: Datu(SZIBS_(G),SZJ_(G)), Datv(SZI_(G),SZJBS_(G)) + real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m. + real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m. real :: gtot_estimate ! Summing GV%g_prime gives an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed. diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index f1f0ed9733..c47b16989e 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -49,8 +49,9 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Volume flux through meridional !! faces = v*h*dx, in m3 s-1. - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's basic state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. @@ -87,8 +88,9 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's basic state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. @@ -118,7 +120,7 @@ subroutine MOM_thermo_chksum(mesg, tv, G, haloshift) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: haloshift + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). ! This subroutine writes out chksums for the model's thermodynamic state ! variables. ! Arguments: mesg - A message that appears on the chksum lines. @@ -144,8 +146,9 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) !! structure shared with the calling routine; !! data in this structure is intent out. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's thermodynamic state ! variables. ! Arguments: mesg - A message that appears on the chksum lines. @@ -197,14 +200,15 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies, in - !! m2 s-2 H-1. !! NULL. + !! m2 s-2 H-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the !! barotropic solver,in m s-2. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in !! the barotropic solver,in m s-2. - logical, optional, intent(in) :: symmetric + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's accelerations. ! Arguments: mesg - A message that appears on the chksum lines. @@ -262,11 +266,9 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi intent(in) :: Temp !< Temperature in degree C. real, pointer, dimension(:,:,:), & intent(in) :: Salt !< Salinity, in ppt. - - logical, optional, intent(in) :: allowChange !< do not flag an error - !! if the statistics change. - logical, optional, & - intent(in) :: permitDiminishing !< do not flag error + logical, optional, intent(in) :: allowChange !< do not flag an error + !! if the statistics change. + logical, optional, intent(in) :: permitDiminishing !< do not flag error !!if the extrema are diminishing. ! This subroutine monitors statistics for the model's state variables. ! Arguments: mesg - A message that appears on the chksum lines. diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index f4c3bb6d66..121bbfbdb0 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -41,44 +41,62 @@ module MOM_continuity subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m/s. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin !< Initial layer thickness, in m or kg/m2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Final layer thickness, in m or kg/m2. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy, in m3/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional faces = - !! v*h*dx, in m3/s. - real, intent(in) :: dt !< Time increment, in s. - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt !< The vertically summed volume - !! flux through zonal faces, in m3/s. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt !< The vertically summed volume - !! flux through meridional faces, in m3/s. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< Both the fraction of + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m/s. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m/s. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: hin !< Initial layer thickness, in m or kg/m2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Final layer thickness, in m or kg/m2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: uh !< Volume flux through zonal faces = + !! u*h*dy, in m3/s. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: vh !< Volume flux through meridional faces = + !! v*h*dx, in m3/s. + real, intent(in) :: dt !< Time increment, in s. + type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The vertically summed volume + !! flux through zonal faces, in m3/s. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt !< The vertically summed volume + !! flux through meridional faces, in m3/s. + type(ocean_OBC_type), & + optional, pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< Both the fraction of !! zonal momentum that remains after a time-step of viscosity, and the fraction of a time-step's !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< Both the fraction of + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_v !< Both the fraction of !! meridional momentum that remains after a time-step of viscosity, and the fraction of a time-step's !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor !< The zonal velocities that + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor !< The zonal velocities that !! give uhbt as the depth-integrated transport, in m/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor !< The meridional velocities that + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport, in m/s. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux !< A second summed zonal + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt_aux !< A second summed zonal !! volume flux in m3/s. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux !< A second summed meridional + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt_aux !< A second summed meridional !! volume flux in m3/s. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout), optional :: u_cor_aux !< The zonal velocities + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(inout) :: u_cor_aux !< The zonal velocities !! that give uhbt_aux as the depth-integrated transport, in m/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout), optional :: v_cor_aux !< The meridional velocities + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(inout) :: v_cor_aux !< The meridional velocities !! that give vhbt_aux as the depth-integrated transport, in m/s. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements + type(BT_cont_type), & + optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index cfab905b28..c430179917 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -77,45 +77,59 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! In the following documentation, H is used for the units of thickness (usually m or kg m-2.) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin !< Initial layer thickness, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Final layer thickness, in H. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Zonal volume flux, - !! u*h*dy, H m2 s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Meridional volume flux, - !! v*h*dx, H m2 s-1. - real, intent(in) :: dt !< Time increment in s. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt - !< The summed volume flux through zonal faces, H m2 s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt - !< The summed volume flux through meridional faces, H m2 s-1. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u - !< The fraction of zonal momentum originally in a layer that remains after a time-step - !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v - !< The fraction of meridional momentum originally in a layer that remains after a time-step - !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport, in m s-1. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces, in H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux - !< The zonal velocities that give uhbt_aux as the depth-integrated transports, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux - !< The meridional velocities that give vhbt_aux as the depth-integrated transports, in m s-1. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with - !! elements that describe the effective open face areas as a function of barotropic flow. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: hin !< Initial layer thickness, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Final layer thickness, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: uh !< Zonal volume flux, u*h*dy, H m2 s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: vh !< Meridional volume flux, v*h*dx, H m2 s-1. + real, intent(in) :: dt !< Time increment in s. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. + type(ocean_OBC_type), & + optional, pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally + !! in a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. + !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally + !! in a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. + !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor !< The zonal velocities that give uhbt as the + !! depth-integrated transport, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor !< The meridional velocities that give vhbt as the + !! depth-integrated transport, in m s-1. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes + !! through zonal faces, in H m2 s-1. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes + !! through meridional faces, in H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor_aux !< The zonal velocities that give uhbt_aux + !! as the depth-integrated transports, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor_aux !< The meridional velocities that give + !! vhbt_aux as the depth-integrated transports, in m s-1. + type(BT_cont_type), & + optional, pointer :: BT_cont !< A structure with elements that describe + !! the effective open face areas as a function of barotropic flow. ! Local variables real :: h_min ! The minimum layer thickness, in H. h_min could be 0. @@ -207,35 +221,39 @@ end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) - type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Volume flux through zonal - !! faces = u*h*dy, H m2 s-1. - real, intent(in) :: dt !< Time increment in s. - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. - type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< - !! The fraction of zonal momentum originally in a layer that remains after a time-step - !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt - !< The summed volume flux through zonal faces, H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor - !< The zonal velocitiess (u with a barotropic correction) - !! that give uhbt as the depth-integrated transport, m s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux - !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports, in m s-1. - type(BT_cont_type), pointer, optional :: BT_cont !< - !< A structure with elements that describe the effective - !! open face areas as a function of barotropic flow. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: uh !< Volume flux through zonal faces = u*h*dy, H m2 s-1. + real, intent(in) :: dt !< Time increment in s. + type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(ocean_OBC_type), & + optional, pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum + !! originally in a layer that remains after a time-step of viscosity, + !! and the fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. Non-dimensional + !! between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through + !! zonal faces, in H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) + !! that give uhbt as the depth-integrated transport, m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor_aux !< The zonal velocities (u with a barotropic correction) + !! that give uhbt_aux as the depth-integrated transports, in m s-1. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the effective + !! open face areas as a function of barotropic flow. + ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u, in H m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses, in H. @@ -532,7 +550,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & logical, dimension(SZIB_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the !! ratio of face areas to the cell areas when estimating the CFL number. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, @@ -599,20 +617,17 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & !! in H. real, intent(in) :: dt !< Time increment in s. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - logical, intent(in) :: vol_CFL !< - !! If true, rescale the ratio of face areas to the cell - !! areas when estimating the CFL number. - logical, intent(in) :: marginal !< - !! If true, report the marginal face thicknesses; otherwise - !! report transport-averaged thicknesses. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< - !! Both the fraction of the momentum originally in a - !! layer that remains after a time-step of viscosity, - !! and the fraction of a time-step's worth of a - !! barotropic acceleration that a layer experiences - !! after viscosity is applied. Non-dimensional between - !! 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + logical, intent(in) :: vol_CFL !< If true, rescale the ratio + !! of face areas to the cell areas when estimating the CFL number. + logical, intent(in) :: marginal !< If true, report the + !! marginal face thicknesses; otherwise report transport-averaged thicknesses. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< Both the fraction of + !! the momentum originally in a layer that remains after a time-step of + !! viscosity, and the fraction of a time-step's worth of a barotropic + !! acceleration that a layer experiences after viscosity is applied. + !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. @@ -713,7 +728,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! barotropic acceleration that a layer experiences !! after viscosity is applied. Non-dimensional between !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G)), intent(in), optional :: uhbt !< + real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< !! The summed volume flux through zonal faces, H m2 s-1. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du, in m s-1. @@ -732,12 +747,12 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I_in !< !! A logical flag indicating which I values to work on. - logical, intent(in), optional :: full_precision !< + logical, optional, intent(in) :: full_precision !< !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout), optional :: uh_3d !< + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< !! Volume flux through zonal faces = u*h*dy, H m2 s-1. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & uh_aux, & ! An auxiliary zonal volume flux, in H m s-1. @@ -1039,28 +1054,33 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, intent(in) :: dt !< Time increment in s. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), pointer, optional :: OBC !< + type(ocean_OBC_type), optional, pointer :: OBC !< !! This open boundary condition type specifies whether, where, !! and what open boundary conditions are used. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_v !< !! Both the fraction of the momentum originally in a !! layer that remains after a time-step of viscosity, !! and the fraction of a time-step's worth of a !! barotropic acceleration that a layer experiences !! after viscosity is applied. Nondimensional between !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt !< + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt !< !! The summed volume flux through meridional faces, H m2 s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux !< + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt_aux !< !! A second set of summed volume fluxes through meridional !! faces, in H m2 s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor !< !! The meridional velocitiess (v with a barotropic correction) !! that give vhbt as the depth-integrated transport, m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor_aux !< !! The meridional velocities (v with a barotropic correction) !! that give vhbt_aux as the depth-integrated transports, in m s-1. - type(BT_cont_type), pointer, optional :: BT_cont !< + type(BT_cont_type), optional, pointer :: BT_cont !< !! A structure with elements that describe the effective ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & @@ -1362,7 +1382,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & logical, dimension(SZI_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the !! ratio of face areas to the cell areas when estimating the CFL number. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, @@ -1436,14 +1456,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & logical, intent(in) :: marginal !< !! If true, report the marginal face thicknesses; otherwise !! report transport-averaged thicknesses. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(in) :: visc_rem_v !< !! Both the fraction of the momentum originally in a !! layer that remains after a time-step of viscosity, !! and the fraction of a time-step's worth of a !! barotropic acceleration that a layer experiences !! after viscosity is applied. Non-dimensional between !! 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. @@ -1530,46 +1550,42 @@ end subroutine merid_face_thickness subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & dv, dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) - type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< - !! Both the fraction of the momentum originally in a - !! layer that remains after a time-step of viscosity, - !! and the fraction of a time-step's worth of a - !! barotropic acceleration that a layer experiences - !! after viscosity is applied. Non-dimensional between - !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G)), intent(in), optional :: vhbt !< - !! The summed volume flux through meridional faces, H m2 s-1. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value - !! of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value - !! of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< - !! The summed transport with 0 adjustment, in H m2 s-1. - real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< - !! The partial derivative of dv_err with dv at 0 adjustment, in H m. - real, dimension(SZI_(G)), intent(out) :: dv !< - !! The barotropic velocity adjustment, in m s-1. - real, intent(in) :: dt !< Time increment in s. - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. - integer, intent(in) :: j !< Spatial index. - integer, intent(in) :: ish !< Start of index range. - integer, intent(in) :: ieh !< End of index range. - logical, dimension(SZI_(G)), intent(in) :: do_I_in !< - !! A logical flag indicating which I values to work on. - logical, intent(in), optional :: full_precision !< - !! full_precision - A flag indicating how carefully to iterate. The - !! default is .true. (more accurate). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout), optional :: vh_3d !< - !! Volume flux through meridional faces = v*h*dx, H m2 s-1. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& + intent(in) :: h_L !< Left thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZK_(G)), & + intent(in) :: visc_rem !< Both the fraction of the momentum originally + !! in a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. Non-dimensional + !! between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G)), & + optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. + real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment, in H m2 s-1. + real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with + !! dv at 0 adjustment, in H m. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment, in m s-1. + real, intent(in) :: dt !< Time increment in s. + type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + integer, intent(in) :: j !< Spatial index. + integer, intent(in) :: ish !< Start of index range. + integer, intent(in) :: ieh !< End of index range. + logical, dimension(SZI_(G)), & + intent(in) :: do_I_in !< A flag indicating which I values to work on. + logical, optional, intent(in) :: full_precision !< A flag indicating + !! how carefully to iterate. The default is .true. (more accurate). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(inout) :: vh_3d !< Volume flux through + !! meridional faces = v*h*dx, H m2 s-1. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & vh_aux, & ! An auxiliary meridional volume flux, in H m s-1. @@ -1873,7 +1889,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, optional, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. @@ -2012,7 +2028,7 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, optional, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 6735e35063..9688ca2dcc 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -93,27 +93,34 @@ module MOM_dynamics_split_RK2 !! that were fed into the barotopic calculation, in m s-2. ! The following variables are only used with the split time stepping scheme. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq mode) - !! or column mass anomaly (in non-Boussinesq mode), - !! in units of H (m or kg m-2) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic timestep (m s-1) - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic timestep (m s-1) - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer thicknesses (m or kg m-2) - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and PFv (meter) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by barotropic solver - !! (m3 s-1 or kg s-1). uhbt should (roughly?) equal to vertical sum of uh. - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by barotropic solver - !! (m3 s-1 or kg s-1). vhbt should (roughly?) equal to vertical sum of vh. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure anomaly in each layer due - !! to free surface height anomalies. pbce has units of m2 H-1 s-2. - - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) - type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the - !! effective summed open face areas as a function - !! of barotropic flow. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq + !! mode) or column mass anomaly (in non-Boussinesq + !! mode), in units of H (m or kg m-2) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep (m s-1) + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep (m s-1) + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer + !! thicknesses (m or kg m-2) + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and + !! PFv (meter) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the + !! barotropic solver (m3 s-1 or kg s-1). uhbt should + !! be (roughly?) equal to vertical sum of uh. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the + !! barotropic solver (m3 s-1 or kg s-1). vhbt should + !! be (roughly?) equal to vertical sum of vh. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure + !! anomaly in each layer due to free surface height + !! anomalies. pbce has units of m2 H-1 s-2. + + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the + !! effective summed open face areas as a function + !! of barotropic flow. ! This is to allow the previous, velocity-based coupling with between the ! baroclinic and barotropic modes. @@ -205,27 +212,39 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & G, GV, CS, calc_dtbt, VarMix, MEKE) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thickness (m or kg/m2) - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type - type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related - type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step (sec) - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic time step (Pa) - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic time step (Pa) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulatated zonal volume/mass transport since last tracer advection (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulatated merid volume/mass transport since last tracer advection (m3 or kg) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time averaged over time step (m or kg/m2) - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: v !< merid velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< layer thickness (m or kg/m2) + type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type + type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related + type(time_type), intent(in) :: Time_local !< model time at end of time step + real, intent(in) :: dt !< time step (sec) + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic + !! time step (Pa) + real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic + !! time step (Pa) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + !! since last tracer advection (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< accumulatated merid volume/mass transport + !! since last tracer advection (m3 or kg) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time + !! averaged over time step (m or kg/m2) + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step + type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities + type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. @@ -842,8 +861,10 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) - real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -915,34 +936,41 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, calc_dtbt) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) - type(time_type), target, intent(in) :: Time !< current model time - type(param_file_type), intent(in) :: param_file !< parameter file for parsing - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, intent(in) :: dt !< time step (sec) - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for budget analysis - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation - type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields - type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields - type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields - type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related - type(directories), intent(in) :: dirs !< contains directory paths - integer, target, intent(inout) :: ntrunc !< A target for the variable that records the number of times - !! the velocity is truncated (this should be 0). - logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< merid velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) + type(time_type), target, intent(in) :: Time !< current model time + type(param_file_type), intent(in) :: param_file !< parameter file for parsing + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + real, intent(in) :: dt !< time step (sec) + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for + !! budget analysis + type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation + type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass + !! diagnostic pointers + type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities + type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields + type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields + type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields + type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure + type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related + type(directories), intent(in) :: dirs !< contains directory paths + integer, target, intent(inout) :: ntrunc !< A target for the variable that records + !! the number of times the velocity is + !! truncated (this should be 0). + logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index d4e64ef019..aa97b01915 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -166,49 +166,51 @@ module MOM_dynamics_unsplit subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & VarMix, MEKE, Waves) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity, in m s-1. + intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity, in m s-1. + intent(inout) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H. - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables. - type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + intent(inout) :: h !< Layer thicknesses, in H. + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities, bottom drag viscosities, and related fields. - type(time_type), intent(in) :: Time_local !< The model time at the end - !! of the time step. - real, intent(in) :: dt !< The dynamics time step, in s. - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the + type(time_type), intent(in) :: Time_local !< The model time at the end + !! of the time step. + real, intent(in) :: dt !< The dynamics time step, in s. + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the !! surface pressure at the beginning of this dynamic step, in Pa. - real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the !! surface pressure at the end of this dynamic step, in Pa. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< The zonal volume or mass transport, - !! in m3 s-1 or kg s-1. + intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< The meridional volume or mass - !! transport, in m3 s-1 or kg s-1. + intent(inout) :: vh !< The meridional volume or mass + !! transport, in m3 s-1 or kg s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< he accumulated zonal volume or mass - !! transport since the last tracer advection, in m3 or kg. + intent(inout) :: uhtr !< he accumulated zonal volume or mass + !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< The accumulated meridional volume or - !! mass transport since the last tracer advection, in m3 or kg. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in m or kg m-2. - type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by - !! initialize_dyn_unsplit. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields - !! that specify the spatially variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing - !! fields related to the Mesoscale Eddy Kinetic Energy. - type(wave_parameters_CS), pointer, optional :: Waves !< A pointer to a structure containing - !! fields related to the surface wave conditions + intent(inout) :: vhtr !< The accumulated meridional volume or + !! mass transport since the last tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: eta_av !< The time-mean free surface height or + !! column mass, in m or kg m-2. + type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_unsplit. + type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields + !! that specify the spatially variable viscosities. + type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + !! fields related to the Mesoscale Eddy Kinetic Energy. + type(wave_parameters_CS), & + optional, pointer :: Waves !< A pointer to a structure containing + !! fields related to the surface wave conditions ! Arguments: u - The input and output zonal velocity, in m s-1. ! (inout) v - The input and output meridional velocity, in m s-1. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 2d94984d4e..6a65c7e844 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -194,6 +194,10 @@ module MOM_forcing_type !! This may point to p_surf or to p_surf_full. net_mass_src => NULL(), & !< The net mass source to the ocean, in kg m-2 s-1. + ! iceberg related inputs + area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) + mass_berg => NULL(), & !< mass of icebergs (kg/m2) + ! land ice-shelf related inputs frac_shelf_u => NULL(), & !< Fractional ice shelf coverage of u-cells, nondimensional !! from 0 to 1. This is only associated if ice shelves are @@ -203,6 +207,9 @@ module MOM_forcing_type !< enabled, and is exactly 0 away from shelves or on land. rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice rigidity_ice_v => NULL() !< shelves or sea ice at u- or v-points (m3/s) + + logical :: initialized = .false. !< This indicates whether the appropriate + !! arrays have been initialized. end type mech_forcing !> Structure that defines the id handles for the forcing type @@ -309,67 +316,73 @@ module MOM_forcing_type !! This routine multiplies fluxes by dt, so that the result is an accumulation of fluxes !! over a time step. subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & + FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & - aggregate_FW_forcing, nonpenSW, netmassInOut_rate,net_Heat_Rate, & + aggregate_FW, nonpenSW, netmassInOut_rate,net_Heat_Rate, & net_salt_rate, pen_sw_bnd_Rate, skip_diags) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible - !! forcing fields. NULL unused fields. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - integer, intent(in) :: j !< j-index to work on - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: DepthBeforeScalingFluxes !< min ocean depth before scale away fluxes (H) - logical, intent(in) :: useRiverHeatContent !< logical for river heat content - logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible + !! forcing fields. NULL unused fields. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + integer, intent(in) :: j !< j-index to work on + real, intent(in) :: dt !< time step in seconds + real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + logical, intent(in) :: useRiverHeatContent !< logical for river heat content + logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H units) + intent(in) :: h !< layer thickness (in H units) real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step (H units) - real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). - !! netMassOut < 0 means mass leaves ocean. - real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step for coupler + restoring. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know evap temperature). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) - real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! Units are (deg K * H) and array size - !! nsw x SZI_(G), where nsw=number of SW bands - !! in pen_SW_bnd. This heat flux is not part - !! of net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW_forcing !< For determining how to aggregate forcing. - real, dimension(SZI_(G)), optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. - !! Sum over SW bands when diagnosing nonpenSW. - !! Units are (K * H). - real, dimension(SZI_(G)), optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. - real, dimension(SZI_(G)), optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. - real, dimension(SZI_(G)), optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. - real, dimension(:,:), optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating in degC H s-1. - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics + intent(in) :: T !< layer temperatures (deg C) + real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step (H units) + real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step (H units). + !! netMassOut < 0 means mass leaves ocean. + real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step for coupler + restoring. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know evap temperature). + !! Units of net_heat are (K * H). + real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step (ppt * H) + real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. + !! Units are (deg K * H) and array size + !! nsw x SZI_(G), where nsw=number of SW bands + !! in pen_SW_bnd. This heat flux is not part + !! of net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing. + real, dimension(SZI_(G)), & + optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. + !! Sum over SW bands when diagnosing nonpenSW. + !! Units are (K * H). + real, dimension(SZI_(G)), & + optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. + real, dimension(SZI_(G)), & + optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. + real, dimension(SZI_(G)), & + optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. + real, dimension(:,:), & + optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating + !! in degC H s-1. + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss) real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW (K * H) real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) real :: Ih_limit ! inverse depth at which surface fluxes start to be limited (1/H) - real :: scale ! scale scales away fluxes if depth < DepthBeforeScalingFluxes + real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth real :: J_m2_to_H ! converts J/m^2 to H units (m for Bouss and kg/m^2 for non-Bouss) real :: Irho0 ! 1.0 / Rho0 real :: I_Cp ! 1.0 / C_p @@ -393,7 +406,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (present(pen_sw_bnd_rate)) do_PSWBR = .true. !}BGR - Ih_limit = 1.0 / DepthBeforeScalingFluxes + Ih_limit = 1.0 / FluxRescaleDepth Irho0 = 1.0 / GV%Rho0 I_Cp = 1.0 / fluxes%C_p J_m2_to_H = 1.0 / (GV%H_to_kg_m2 * fluxes%C_p) @@ -630,11 +643,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. if (associated(fluxes%heat_content_massin)) then - if (aggregate_FW_forcing) then + if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt else ! net is "out" - fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_kg_m2 / dt endif else fluxes%heat_content_massin(i,j) = 0. @@ -644,11 +658,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components. if (associated(fluxes%heat_content_massout)) then - if (aggregate_FW_forcing) then + if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_kg_m2 / dt endif else fluxes%heat_content_massout(i,j) = 0.0 @@ -730,58 +745,59 @@ end subroutine extractFluxes1d !> 2d wrapper for 1d extract fluxes from surface fluxes type. !! This subroutine extracts fluxes from the surface fluxes type. It multiplies the !! fluxes by dt, so that the result is an accumulation of the fluxes over a time step. -subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & - h, T, netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & - aggregate_FW_forcing) - - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: DepthBeforeScalingFluxes !< min ocean depth before scale away fluxes (H) - logical, intent(in) :: useRiverHeatContent !< logical for river heat content - logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (in H units) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step (H units) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step associated with coupler + restore. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know temperature of evap). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! Units (deg K * H) & array size nsw x SZI_(G), - !! where nsw=number of SW bands in pen_SW_bnd. - !! This heat flux is not in net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Here it is used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW_forcing !< For determining how to aggregate the forcing. - +subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & + useRiverHeatContent, useCalvingHeatContent, h, T, & + netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & + aggregate_FW) + + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + real, intent(in) :: dt !< time step in seconds + real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + logical, intent(in) :: useRiverHeatContent !< logical for river heat content + logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< layer thickness (in H units) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: T !< layer temperatures (deg C) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step (H units) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step (H units). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step associated with coupler + restore. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know temperature of evap). + !! Units of net_heat are (K * H). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step (ppt * H) + real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. + !! Units (deg K * H) & array size nsw x SZI_(G), + !! where nsw=number of SW bands in pen_SW_bnd. + !! This heat flux is not in net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Here it is used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j -!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,DepthBeforeScalingFluxes, & +!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,FluxRescaleDepth, & !$OMP useRiverHeatContent, useCalvingHeatContent, & !$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, & -!$OMP aggregate_FW_forcing) +!$OMP aggregate_FW) do j=G%jsc, G%jec call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent,& + FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent,& h(:,j,:), T(:,j,:), netMassInOut(:,j), netMassOut(:,j), & - net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW_forcing) + net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW) enddo end subroutine extractFluxes2d @@ -805,8 +821,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux (m^2/s^3) real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux (K H/s) real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux (ppt H/s) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating - !! diagnostics inside extractFluxes1d() + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + !! diagnostics inside extractFluxes1d() ! local variables integer :: nsw, start, npts, k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d @@ -893,7 +909,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux (m^2/s^3) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux (K H) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux (ppt H) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables real, dimension( SZI_(G) ) :: netT ! net temperature flux (K m/s) @@ -1515,7 +1531,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_total_net_heat_surface = register_scalar_field('ocean_model', & 'total_net_heat_surface', Time, diag, & - long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & units='W', & cmor_field_name='total_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_integrated', & @@ -1602,7 +1618,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & @@ -1719,12 +1735,14 @@ end subroutine register_forcing_type_diags !> Accumulate the forcing over time steps subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) - type(forcing), intent(in) :: flux_tmp + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !!thermodynamic forcing fields type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, intent(out) :: wt2 + real, intent(out) :: wt2 !< The relative weight of the new fluxes ! This subroutine copies mechancal forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, @@ -1844,37 +1862,43 @@ end subroutine forcing_accumulate !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. -subroutine copy_common_forcing_fields(forces, fluxes, G) +subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< grid type + logical, optional, intent(in) :: skip_pres !< If present and true, do not copy pressure fields. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + logical :: do_pres integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres + if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie fluxes%ustar(i,j) = forces%ustar(i,j) enddo ; enddo endif - if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then - do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = forces%p_surf(i,j) - enddo ; enddo - endif + if (do_pres) then + if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = forces%p_surf(i,j) + enddo ; enddo + endif - if (associated(forces%p_surf_full) .and. associated(fluxes%p_surf_full)) then - do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) - enddo ; enddo - endif + if (associated(forces%p_surf_full) .and. associated(fluxes%p_surf_full)) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) + enddo ; enddo + endif - if (associated(forces%p_surf_SSH, forces%p_surf_full)) then - fluxes%p_surf_SSH => fluxes%p_surf_full - elseif (associated(forces%p_surf_SSH, forces%p_surf)) then - fluxes%p_surf_SSH => fluxes%p_surf + if (associated(forces%p_surf_SSH, forces%p_surf_full)) then + fluxes%p_surf_SSH => fluxes%p_surf_full + elseif (associated(forces%p_surf_SSH, forces%p_surf)) then + fluxes%p_surf_SSH => fluxes%p_surf + endif endif end subroutine copy_common_forcing_fields @@ -2010,7 +2034,7 @@ end subroutine mech_forcing_diags !> Offer buoyancy forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) - type(forcing), intent(in) :: fluxes !< flux type + type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. real, intent(in) :: dt !< time step @@ -2229,7 +2253,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif - if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. handles%id_net_heat_coupler_ga > 0. ) then + if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. & + handles%id_net_heat_coupler_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) @@ -2248,7 +2273,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. handles%id_net_heat_surface_ga > 0. ) then + if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. & + handles%id_net_heat_surface_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) @@ -2498,7 +2524,7 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(forcing), intent(inout) :: fluxes !< Forcing fields structure + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields logical, optional, intent(in) :: water !< If present and true, allocate water fluxes logical, optional, intent(in) :: heat !< If present and true, allocate heat fluxes logical, optional, intent(in) :: ustar !< If present and true, allocate ustar and related fields @@ -2594,6 +2620,10 @@ subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg call myAlloc(forces%frac_shelf_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%frac_shelf_v,isd,ied,JsdB,JedB, shelf) + !These fields should only on allocated when iceberg area is being passed through the coupler. + call myAlloc(forces%area_berg,isd,ied,jsd,jed, iceberg) + call myAlloc(forces%mass_berg,isd,ied,jsd,jed, iceberg) + end subroutine allocate_mech_forcing !> Allocates and zeroes-out array. @@ -2667,13 +2697,15 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%taux)) deallocate(forces%taux) if (associated(forces%tauy)) deallocate(forces%tauy) if (associated(forces%ustar)) deallocate(forces%ustar) - if (associated(forces%p_surf)) deallocate(forces%p_surf) - if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) + if (associated(forces%p_surf)) deallocate(forces%p_surf) + if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) if (associated(forces%frac_shelf_u)) deallocate(forces%frac_shelf_u) if (associated(forces%frac_shelf_v)) deallocate(forces%frac_shelf_v) + if (associated(forces%area_berg)) deallocate(forces%area_berg) + if (associated(forces%mass_berg)) deallocate(forces%mass_berg) end subroutine deallocate_mech_forcing diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 86aa5bddb7..75140c3d4f 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -434,9 +434,10 @@ logical function isPointInCell(G, i, j, x, y) endif end function isPointInCell +!> Store an integer indicating which direction to work on first. subroutine set_first_direction(G, y_first) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - integer, intent(in) :: y_first + integer, intent(in) :: y_first !< The first direction to store G%first_direction = y_first end subroutine set_first_direction @@ -568,18 +569,21 @@ end subroutine MOM_grid_end !! !! Grid metrics and their inverses are labelled according to their staggered location on a Arakawa C (or B) grid. !! - Metrics centered on h- or T-points are labelled T, e.g. dxT is the distance across the cell in the x-direction. -!! - Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between two corners of a T-cell. +!! - Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between +!! two corners of a T-cell. !! - Metrics centered on v-points are labelled Cv (C-grid v location). e.g. dyCv is the y-distance between two -points. !! - Metrics centered on q-points are labelled Bu (B-grid u,v location). e.g. areaBu is the area centered on a q-point. !! -!! \image html Grid_metrics.png "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. +!! \image html Grid_metrics.png +!! "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. !! !! Areas centered at T-, u-, v- and q- points are `areaT`, `areaCu`, `areaCv` and `areaBu` respectively. !! !! The reciprocal of metrics are pre-calculated and also stored in the ocean_grid_type with a I prepended to the name. !! For example, `1./areaT` is called `IareaT`, and `1./dyCv` is `IdyCv`. !! -!! Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in `geoLatT`, `geoLonT` for T-points. +!! Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in +!! `geoLatT`, `geoLonT` for T-points. !! u-, v- and q- point coordinates are follow same pattern of replacing T with Cu, Cv and Bu respectively. !! !! Each location also has a 2D mask indicating whether the entire column is land or ocean. diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index bb96f82fe4..c677f3863c 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -23,14 +23,19 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, intent(in) :: dt_kappa_smooth + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing + !! timescale, in s. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at u-points (s-2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at u-points (s-2) - optional :: N2_u, N2_v - integer, optional, intent(in) :: halo !< Halo width over which to compute + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & + optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at + !! interfaces between u-points (s-2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & + optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at + !! interfaces between u-points (s-2) + integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -307,16 +312,16 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) - real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) - real, intent(in) :: dt !< The time increment, in s. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) - integer, optional, intent(in) :: halo_here !< Halo width over which to compute + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) + real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) + real, intent(in) :: dt !< The time increment, in s. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) + integer, optional, intent(in) :: halo_here !< Halo width over which to compute ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep in m or kg m-2. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 606ab1e96b..9f5d79ef4e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -745,7 +745,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" integer, intent(in) :: l_seg !< which segment is this? - type(param_file_type), intent(in) :: PF + type(param_file_type), intent(in) :: PF !< Parameter file handle ! Local variables integer :: I_obc, Js_obc, Je_obc ! Position of segment in global index space integer :: j, a_loop @@ -848,7 +848,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" integer, intent(in) :: l_seg !< which segment is this? - type(param_file_type), intent(in) :: PF + type(param_file_type), intent(in) :: PF !< Parameter file handle ! Local variables integer :: J_obc, Is_obc, Ie_obc ! Position of segment in global index space integer :: i, a_loop @@ -955,7 +955,8 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ integer, intent(out) :: n !< The value of J=n, if segment_str begins with I=, or the value of I=n character(len=*), intent(out) :: action_str(:) !< The "string" part of segment_str ! Local variables - character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of "I=%,J=%:%,string" + character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of + !! "I=%,J=%:%,string" integer :: l_max !< Either ni_global or nj_global, depending on whether segment_str begins with "I=" or "J=" integer :: mn_max !< Either nj_global or ni_global, depending on whether segment_str begins with "I=" or "J=" integer :: j @@ -1039,14 +1040,17 @@ end subroutine parse_segment_str !> Parse an OBC_SEGMENT_%%%_DATA string subroutine parse_segment_data_str(segment_str, var, value, filenam, fieldnam, fields, num_fields, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in), optional :: var !< The name of the variable for which parameters are needed - character(len=*), intent(out), optional :: filenam !< The name of the input file if using "file" method - character(len=*), intent(out), optional :: fieldnam !< The name of the variable in the input file if using "file" method - real, intent(out), optional :: value !< A constant value if using the "value" method - character(len=*), dimension(MAX_OBC_FIELDS), intent(out), optional :: fields !< List of fieldnames for each segment - integer, intent(out), optional :: num_fields - logical, intent(in), optional :: debug + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), optional, intent(in) :: var !< The name of the variable for which parameters are needed + character(len=*), optional, intent(out) :: filenam !< The name of the input file if using "file" method + character(len=*), optional, intent(out) :: fieldnam !< The name of the variable in the input file if using + !! "file" method + real, optional, intent(out) :: value !< A constant value if using the "value" method + character(len=*), dimension(MAX_OBC_FIELDS), & + optional, intent(out) :: fields !< List of fieldnames for each segment + integer, optional, intent(out) :: num_fields !< The number of fields in the segment data + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1124,10 +1128,11 @@ end subroutine parse_segment_data_str !> Parse an OBC_SEGMENT_%%%_PARAMS string subroutine parse_segment_param_real(segment_str, var, param_value, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed - real, intent(out) :: param_value !< The value of the parameter - logical, intent(in), optional :: debug + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed + real, intent(out) :: param_value !< The value of the parameter + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1218,13 +1223,14 @@ subroutine open_boundary_init(G, param_file, OBC) end subroutine open_boundary_init -logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, apply_nudged_OBC, needs_ext_seg_data) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - logical, optional, intent(in) :: apply_open_OBC !< If present, returns True if specified_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_specified_OBC !< If present, returns True if specified_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_Flather_OBC !< If present, returns True if Flather_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_nudged_OBC !< If present, returns True if nudged_*_BCs_exist_globally is true - logical, optional, intent(in) :: needs_ext_seg_data !< If present, returns True if external segment data needed +logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, & + apply_nudged_OBC, needs_ext_seg_data) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + logical, optional, intent(in) :: apply_open_OBC !< Returns True if open_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_specified_OBC !< Returns True if specified_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_Flather_OBC !< Returns True if Flather_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_nudged_OBC !< Returns True if nudged_*_BCs_exist_globally is true + logical, optional, intent(in) :: needs_ext_seg_data !< Returns True if external segment data needed open_boundary_query = .false. if (.not. associated(OBC)) return if (present(apply_open_OBC)) open_boundary_query = OBC%open_u_BCs_exist_globally .or. & @@ -2293,15 +2299,19 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) endif endif else @@ -2324,15 +2334,19 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) endif endif else @@ -2730,9 +2744,9 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & !! available subsequently to the tracer registry. type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values type(OBC_segment_type), intent(inout) :: segment !< current segment data structure - real, optional :: OBC_scalar !< If present, use scalar value for segment tracer + real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer !! inflow concentration. - logical, optional :: OBC_array !< If true, use array values for segment tracer + logical, optional, intent(in) :: OBC_array !< If true, use array values for segment tracer !! inflow concentration. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index f7fa45f12c..09305eb9fb 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -281,7 +281,8 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. - logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically integrated fields. + logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically + !! integrated fields. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean !! ocean and surface-ice fields that will participate @@ -359,9 +360,10 @@ end subroutine deallocate_surface_state !> alloc_BT_cont_type allocates the arrays contained within a BT_cont_type and !! initializes them to 0. subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) - type(BT_cont_type), pointer :: BT_cont + type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be allocated type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - logical, optional, intent(in) :: alloc_faces + logical, optional, intent(in) :: alloc_faces !< If present and true, allocate + !! memory for effective face thicknesses. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -416,33 +418,23 @@ end subroutine dealloc_BT_cont_type !> MOM_thermovar_chksum does diagnostic checksums on various elements of a !! thermo_var_ptrs type for debugging. subroutine MOM_thermovar_chksum(mesg, tv, G) - character(len=*), intent(in) :: mesg - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! This subroutine writes out chksums for the model's basic state variables. -! Arguments: mesg - A message that appears on the chksum lines. -! (in) u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (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. - integer :: is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + character(len=*), intent(in) :: mesg !< A message that appears in the checksum lines + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(tv%T)) & - call hchksum(tv%T, mesg//" tv%T",G%HI) + call hchksum(tv%T, mesg//" tv%T", G%HI) if (associated(tv%S)) & - call hchksum(tv%S, mesg//" tv%S",G%HI) + call hchksum(tv%S, mesg//" tv%S", G%HI) if (associated(tv%frazil)) & - call hchksum(tv%frazil, mesg//" tv%frazil",G%HI) + call hchksum(tv%frazil, mesg//" tv%frazil", G%HI) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit",G%HI) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE",G%HI) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI) end subroutine MOM_thermovar_chksum end module MOM_variables diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index a57bd1f61f..c03a811400 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -16,50 +16,50 @@ module MOM_verticalGrid type, public :: verticalGrid_type ! Commonly used parameters - integer :: ke ! The number of layers/levels in the vertical - real :: max_depth ! The maximum depth of the ocean in meters. - real :: g_Earth ! The gravitational acceleration in m s-2. - real :: Rho0 ! The density used in the Boussinesq approximation or - ! nominal density used to convert depths into mass - ! units, in kg m-3. + integer :: ke !< The number of layers/levels in the vertical + real :: max_depth !< The maximum depth of the ocean in meters. + real :: g_Earth !< The gravitational acceleration in m s-2. + real :: Rho0 !< The density used in the Boussinesq approximation or + !! nominal density used to convert depths into mass + !! units, in kg m-3. ! Vertical coordinate descriptions for diagnostics and I/O character(len=40) :: & - zAxisUnits, & ! The units that vertical coordinates are written in - zAxisLongName ! Coordinate name to appear in files, - ! e.g. "Target Potential Density" or "Height" - real ALLOCABLE_, dimension(NKMEM_) :: sLayer ! Coordinate values of layer centers - real ALLOCABLE_, dimension(NK_INTERFACE_) :: sInterface ! Coordinate values on interfaces - integer :: direction = 1 ! Direction defaults to 1, positive up. + zAxisUnits, & !< The units that vertical coordinates are written in + zAxisLongName !< Coordinate name to appear in files, + !! e.g. "Target Potential Density" or "Height" + real ALLOCABLE_, dimension(NKMEM_) :: sLayer !< Coordinate values of layer centers + real ALLOCABLE_, dimension(NK_INTERFACE_) :: sInterface !< Coordinate values on interfaces + integer :: direction = 1 !< Direction defaults to 1, positive up. ! The following variables give information about the vertical grid. - logical :: Boussinesq ! If true, make the Boussinesq approximation. - real :: Angstrom ! A one-Angstrom thickness in the model's thickness - ! units. (This replaces the old macro EPSILON.) - real :: Angstrom_z ! A one-Angstrom thickness in m. - real :: H_subroundoff ! A thickness that is so small that it can be added to - ! a thickness of Angstrom or larger without changing it - ! at the bit level, in thickness units. If Angstrom is - ! 0 or exceedingly small, this is negligible compared to - ! a thickness of 1e-17 m. + logical :: Boussinesq !< If true, make the Boussinesq approximation. + real :: Angstrom !< A one-Angstrom thickness in the model's thickness + !! units. (This replaces the old macro EPSILON.) + real :: Angstrom_z !< A one-Angstrom thickness in m. + real :: H_subroundoff !< A thickness that is so small that it can be added to + !! a thickness of Angstrom or larger without changing it + !! at the bit level, in thickness units. If Angstrom is + !! 0 or exceedingly small, this is negligible compared to + !! a thickness of 1e-17 m. real ALLOCABLE_, dimension(NK_INTERFACE_) :: & - g_prime, & ! The reduced gravity at each interface, in m s-2. - Rlay ! The target coordinate value (potential density) in - ! in each layer in kg m-3. - integer :: nkml = 0 ! The number of layers at the top that should be treated - ! as parts of a homogenous region. - integer :: nk_rho_varies = 0 ! The number of layers at the top where the - ! density does not track any target density. - real :: H_to_kg_m2 ! A constant that translates thicknesses from the units - ! of thickness to kg m-2. - real :: kg_m2_to_H ! A constant that translates thicknesses from kg m-2 to - ! the units of thickness. - real :: m_to_H ! A constant that translates distances in m to the - ! units of thickness. - real :: H_to_m ! A constant that translates distances in the units of - ! thickness to m. - real :: H_to_Pa ! A constant that translates the units of thickness to - ! to pressure in Pa. + g_prime, & !< The reduced gravity at each interface, in m s-2. + Rlay !< The target coordinate value (potential density) in + !! in each layer in kg m-3. + integer :: nkml = 0 !< The number of layers at the top that should be treated + !! as parts of a homogenous region. + integer :: nk_rho_varies = 0 !< The number of layers at the top where the + !! density does not track any target density. + real :: H_to_kg_m2 !< A constant that translates thicknesses from the units + !! of thickness to kg m-2. + real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to + !! the units of thickness. + real :: m_to_H !< A constant that translates distances in m to the + !! units of thickness. + real :: H_to_m !< A constant that translates distances in the units of + !! thickness to m. + real :: H_to_Pa !< A constant that translates the units of thickness to + !! to pressure in Pa. end type verticalGrid_type contains @@ -68,8 +68,8 @@ module MOM_verticalGrid subroutine verticalGridInit( param_file, GV ) ! This routine initializes the verticalGrid_type structure (GV). ! All memory is allocated but not necessarily set to meaningful values until later. - type(param_file_type), intent(in) :: param_file ! Parameter file handle/type - type(verticalGrid_type), pointer :: GV ! The container for vertical grid data + type(param_file_type), intent(in) :: param_file !< Parameter file handle/type + type(verticalGrid_type), pointer :: GV !< The container for vertical grid data ! This include declares and sets the variable "version". #include "version_variable.h" integer :: nk, H_power diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 097a0e13b3..6e557426c7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -62,7 +62,8 @@ module MOM_diagnostics type, public :: diagnostics_CS ; private real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as - !! monotonic for the purposes of calculating the equivalent barotropic wave speed. + !! monotonic for the purposes of calculating the equivalent + !! barotropic wave speed. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed. (m) @@ -1307,7 +1308,8 @@ end subroutine post_surface_diagnostics !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, diag_to_Z_CSp, Reg) +subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, & + diag_to_Z_CSp, Reg) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1352,7 +1354,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d call post_data(IDs%id_umo_2d, umo2d, diag) endif if (IDs%id_umo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + ! Convert to kg/s. do k=1,nz ; do j=js,je ; do I=is-1,ie umo(I,j,k) = uhtr(I,j,k) * H_to_kg_m2_dt enddo ; enddo ; enddo @@ -1366,7 +1368,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d call post_data(IDs%id_vmo_2d, vmo2d, diag) endif if (IDs%id_vmo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + ! Convert to kg/s. do k=1,nz ; do J=js-1,je ; do i=is,ie vmo(i,J,k) = vhtr(i,J,k) * H_to_kg_m2_dt enddo ; enddo ; enddo @@ -1375,7 +1377,8 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d if (IDs%id_uhtr > 0) call post_data(IDs%id_uhtr, uhtr, diag, alt_h = diag_pre_dyn%h_state) if (IDs%id_vhtr > 0) call post_data(IDs%id_vhtr, vhtr, diag, alt_h = diag_pre_dyn%h_state) - if (IDs%id_dynamics_h > 0 ) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, alt_h = diag_pre_dyn%h_state) + if (IDs%id_dynamics_h > 0) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, & + alt_h = diag_pre_dyn%h_state) ! Post the change in thicknesses if (IDs%id_dynamics_h_tendency > 0) then h_tend(:,:,:) = 0. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 18de7c2902..a036509437 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -38,15 +38,15 @@ module MOM_sum_output !********+*********+*********+*********+*********+*********+*********+** use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs -use MOM_coms, only : reproducing_sum -use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_to_real, real_to_EFP +use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP +use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=) use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta -use MOM_io, only : create_file, fieldtype, flush_file, open_file, reopen_file, get_filename_appendix -use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field +use MOM_io, only : create_file, fieldtype, flush_file, open_file, reopen_file +use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field, get_filename_appendix use MOM_io, only : APPEND_FILE, ASCII_FILE, SINGLE_FILE, WRITEONLY_FILE use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S @@ -949,24 +949,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc endif end subroutine write_energy -!> This subroutine accumates the net input of volume, and perhaps later salt and -!! heat, through the ocean surface for use in diagnosing conservation. +!> 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) - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible forcing fields. Unused fields are unallocated. + 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. real, intent(in) :: dt !< The amount of time over which to average, in 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 to MOM_sum_output_init. - -! This subroutine accumates the net input of volume, and perhaps later salt and -! heat, through the ocean surface for use in diagnosing conservation. -! 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 - The control structure returned by a previous call to -! MOM_sum_output_init. + type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call + !! to MOM_sum_output_init. + real, dimension(SZI_(G),SZJ_(G)) :: & FW_in, & ! The net fresh water input, integrated over a timestep in kg. salt_in, & ! The total salt added by surface fluxes, integrated diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index fbd0ce2daa..6b0c90e55e 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -25,9 +25,9 @@ module MOM_wave_speed !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as - !! monotonic for the purposes of calculating the equivalent barotropic wave speed. - !! This parameter controls the default behavior of wave_speed() which - !! can be overridden by optional arguments. + !! monotonic for the purposes of calculating the equivalent barotropic + !! wave speed. This parameter controls the default behavior of + !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed. (m) !! This parameter controls the default behavior of wave_speed() which @@ -42,23 +42,25 @@ module MOM_wave_speed !> Calculates the wave speed of the first baroclinic mode. subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & mono_N2_column_fraction, mono_N2_depth, modal_structure) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in units of H (m or kg/m2) - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed - logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational domain. - logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent - !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction - !! of water column over which N2 is limited as monotonic - !! for the purposes of calculating vertical modal structure. - real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as - !! monotonic for the purposes of calculating vertical modal structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness in units of H (m or kg/m2) + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) + type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + logical, optional, intent(in) :: full_halos !< If true, do the calculation + !! over the entire computational domain. + logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent + !! barotropic mode instead of the first baroclinic mode. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction + !! of water column over which N2 is limited as monotonic + !! for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as + !! monotonic for the purposes of calculating vertical + !! modal structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) + optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) ! Local variables real, dimension(SZK_(G)+1) :: & @@ -354,7 +356,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & do itt=1,max_itt lam_it(itt) = lam if (l_use_ebt_mode) then - ! This initialization of det,ddet imply Neumann boundary conditions so that first 3 rows of the matrix are + ! This initialization of det,ddet imply Neumann boundary conditions so that first 3 rows + ! of the matrix are ! / b(1)-lam igl(1) 0 0 0 ... \ ! | igu(2) b(2)-lam igl(2) 0 0 ... | ! | 0 igu(3) b(3)-lam igl(3) 0 ... | @@ -373,7 +376,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & ! | ... 0 igu(kc-1) b(kc-1)-lam igl(kc-1) | ! \ ... 0 0 igu(kc) b(kc)-lam / else - ! This initialization of det,ddet imply Dirichlet boundary conditions so that first 3 rows of the matrix are + ! This initialization of det,ddet imply Dirichlet boundary conditions so that first 3 rows + ! of the matrix are ! / b(2)-lam igl(2) 0 0 0 ... | ! | igu(3) b(3)-lam igl(3) 0 0 ... | ! | 0 igu43) b(4)-lam igl(4) 0 ... | @@ -1088,10 +1092,12 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over + !! which N2 is limited as monotonic for the purposes of + !! calculating the vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + !! as monotonic for the purposes of calculating the + !! vertical modal structure. ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. @@ -1116,10 +1122,12 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over + !! which N2 is limited as monotonic for the purposes of + !! calculating the vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + !! as monotonic for the purposes of calculating the + !! vertical modal structure. if (.not.associated(CS)) call MOM_error(FATAL, & "wave_speed_set_param called with an associated control structure.") diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e94f945c57..f504bf220b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -274,7 +274,8 @@ end subroutine calculate_spec_vol_array subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: T_fr !< Freezing point potential temperature referenced to the surface (degC) + real, intent(out) :: T_fr !< Freezing point potential temperature referenced + !! to the surface (degC) type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -299,7 +300,8 @@ end subroutine calculate_TFreeze_scalar subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced to the surface (degC) + real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced + !! to the surface (degC) integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -327,8 +329,10 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential tempetature, in kg m-3 K-1. - real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, in kg m-3 psu-1. + real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -338,8 +342,8 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, & - start, npts) + call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) case (EOS_UNESCO) call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) case (EOS_WRIGHT) @@ -355,13 +359,16 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star end subroutine calculate_density_derivs_array -!> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar to a one-element array +!> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar +!! to a one-element array subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface (degC) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: drho_dT !< The partial derivative of density with potential tempetature, in kg m-3 K-1. - real, intent(out) :: drho_dS !< The partial derivative of density with salinity, in kg m-3 psu-1. + real, intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -382,8 +389,8 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. -subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - start, npts, EOS) +subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, start, npts, EOS) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) @@ -401,14 +408,14 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case default call MOM_error(FATAL, & "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -417,8 +424,8 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. -subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - EOS) +subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface (degC) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) @@ -434,14 +441,14 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case default call MOM_error(FATAL, & "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -454,8 +461,10 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential temperature, in m3 kg-1 K-1. - real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, in m3 kg-1 / (g/kg). + real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential + !! temperature, in m3 kg-1 K-1. + real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, + !! in m3 kg-1 / (g/kg). integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -771,7 +780,8 @@ subroutine EOS_init(param_file, EOS) units="deg C Pa-1", default=0.0) endif - if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. EOS%form_of_TFreeze /= TFREEZE_TEOS10) then + if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. & + EOS%form_of_TFreeze /= TFREEZE_TEOS10) then call MOM_error(FATAL, "interpret_eos_selection: EOS_TEOS10 or EOS_NEMO \n" //& "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 .") endif @@ -780,8 +790,8 @@ subroutine EOS_init(param_file, EOS) end subroutine EOS_init !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS) -subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, Rho_T0_S0, drho_dT, & - dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) +subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & + Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) type(EOS_type), pointer :: EOS integer, optional, intent(in ) :: form_of_EOS integer, optional, intent(in ) :: form_of_TFreeze @@ -2335,8 +2345,8 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) end subroutine convert_temp_salt_for_TEOS10 ! Extractor routine for the EOS type if the members need to be accessed outside this module -subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, Rho_T0_S0, drho_dT, & - dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) +subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & + Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) type(EOS_type), pointer :: EOS integer, optional, intent(out) :: form_of_EOS integer, optional, intent(out) :: form_of_TFreeze diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index d6a211b6c3..f0811422d5 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -236,8 +236,8 @@ subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs -subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) +subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) real, intent(in) :: T, S, pressure real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T @@ -264,8 +264,8 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS end subroutine calculate_density_second_derivs_scalar_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs -subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) +subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) real, dimension(:), intent(in) :: T, S, pressure real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 26ee96b399..01678dce41 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -235,7 +235,8 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA, arrayB !< The arrays to be checksummed - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -261,7 +262,8 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayA, arrayB !< The arrays to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -425,7 +427,8 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: arrayU !< The u-component array to be checksummed real, dimension(HI%isd:,HI%JsdB:), intent(in) :: arrayV !< The v-component array to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. @@ -445,7 +448,8 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: arrayU !< The u-component array to be checksummed real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: arrayV !< The v-component array to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. @@ -465,7 +469,8 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -608,7 +613,8 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -874,7 +880,8 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1017,7 +1024,8 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isdB:,HI%Jsd:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1154,15 +1162,16 @@ end subroutine chksum_u_3d !---chksum_general interface routines !> Return the bitcount of an arbitrarily sized 3d array -integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) result(subchk) - real, dimension(:,:,:) :: array !< Array to be checksummed - real, optional :: scale_factor !< Factor to scale array by before checksum - integer, optional :: istart !< Starting index in the i-direction - integer, optional :: iend !< Ending index in the i-direction - integer, optional :: jstart !< Starting index in the j-direction - integer, optional :: jend !< Ending index in the j-direction - integer, optional :: kstart !< Starting index in the k-direction - integer, optional :: kend !< Ending index in the k-direction +integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) & + result(subchk) + real, dimension(:,:,:), intent(in) :: array !< Array to be checksummed + real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum + integer, optional, intent(in) :: istart !< Starting index in the i-direction + integer, optional, intent(in) :: iend !< Ending index in the i-direction + integer, optional, intent(in) :: jstart !< Starting index in the j-direction + integer, optional, intent(in) :: jend !< Ending index in the j-direction + integer, optional, intent(in) :: kstart !< Starting index in the k-direction + integer, optional, intent(in) :: kend !< Ending index in the k-direction integer :: i, j, k, bc, is, ie, js, je, ks, ke real :: scale @@ -1191,12 +1200,12 @@ end function chksum_general_3d !> Return the bitcount of an arbitrarily sized 2d array by promotion to a 3d array integer function chksum_general_2d( array_2d, scale_factor, istart, iend, jstart, jend ) - real, dimension(:,:) :: array_2d !< Array to be checksummed - real, optional :: scale_factor !< Factor to scale array by before checksum - integer, optional :: istart !< Starting index in the i-direction - integer, optional :: iend !< Ending index in the i-direction - integer, optional :: jstart !< Starting index in the j-direction - integer, optional :: jend !< Ending index in the j-direction + real, dimension(:,:), intent(in) :: array_2d !< Array to be checksummed + real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum + integer, optional, intent(in) :: istart !< Starting index in the i-direction + integer, optional, intent(in) :: iend !< Ending index in the i-direction + integer, optional, intent(in) :: jstart !< Starting index in the j-direction + integer, optional, intent(in) :: jend !< Ending index in the j-direction integer :: is, ie, js, je real, dimension(:,:,:), allocatable :: array_3d !< Promotion from 2d to 3d array @@ -1210,11 +1219,11 @@ end function chksum_general_2d !> Return the bitcount of an arbitrarily sized 1d array by promotion to a 3d array integer function chksum_general_1d( array_1d, scale_factor, istart, iend ) - real, dimension(:) :: array_1d !< Array to be checksummed - real, optional :: scale_factor !< Factor to scale array by before checksum - integer, optional :: istart !< Starting index in the i-direction - integer, optional :: iend !< Ending index in the i-direction - integer :: is, ie, js, je + real, dimension(:), intent(in) :: array_1d !< Array to be checksummed + real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum + integer, optional, intent(in) :: istart !< Starting index in the i-direction + integer, optional, intent(in) :: iend !< Ending index in the i-direction + integer :: is, ie real, dimension(:,:,:), allocatable :: array_3d !< Promotion from 2d to 3d array is = LBOUND(array_1d,1) ; ie = UBOUND(array_1d,1) @@ -1232,7 +1241,8 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1512,8 +1522,9 @@ end function is_NaN_0d !> This function returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) real, dimension(:), intent(in) :: x !< The array to be checked for NaNs. + logical, optional, intent(in) :: skip_mpp !< If true, only check this array only + !! on the local PE (default false). logical :: is_NaN_1d - logical, optional :: skip_mpp !< If true, only check this array only on the local PE (default false). integer :: i, n logical :: call_mpp diff --git a/src/framework/MOM_diag_manager_wrapper.F90 b/src/framework/MOM_diag_manager_wrapper.F90 index 81e26634a7..0274617d32 100644 --- a/src/framework/MOM_diag_manager_wrapper.F90 +++ b/src/framework/MOM_diag_manager_wrapper.F90 @@ -19,20 +19,25 @@ module MOM_diag_manager_wrapper integer function register_diag_field_array_fms(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or + !! "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - integer, intent(in) :: axes(:) !< Container w/ up to 3 integer handles that indicates axes for this field + integer, intent(in) :: axes(:) !< Container w/ up to 3 integer handles that + !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be + !! interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) integer, optional, intent(in) :: area !< The FMS id of cell area integer, optional, intent(in) :: volume !< The FMS id of cell volume @@ -50,7 +55,8 @@ end function register_diag_field_array_fms integer function register_diag_field_scalar_fms(module_name, field_name, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. @@ -58,11 +64,14 @@ integer function register_diag_field_scalar_fms(module_name, field_name, init_ti character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might + !! be placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) integer, optional, intent(in) :: area !< The FMS id of cell area (not used for scalars) integer, optional, intent(in) :: volume !< The FMS id of cell volume (not used for scalars) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index cd378cff09..e37e4bddff 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -78,9 +78,12 @@ module MOM_diag_mediator type(diag_ctrl), pointer :: diag_cs => null() !< Circular link back to the main diagnostics control structure !! (Used to avoid passing said structure into every possible call). ! ID's for cell_methods - character(len=9) :: x_cell_method = '' !< Default nature of data representation, if axes group includes x-direction. - character(len=9) :: y_cell_method = '' !< Default nature of data representation, if axes group includes y-direction. - character(len=9) :: v_cell_method = '' !< Default nature of data representation, if axes group includes vertical direction. + character(len=9) :: x_cell_method = '' !< Default nature of data representation, if axes group + !! includes x-direction. + character(len=9) :: y_cell_method = '' !< Default nature of data representation, if axes group + !! includes y-direction. + character(len=9) :: v_cell_method = '' !< Default nature of data representation, if axes group + !! includes vertical direction. ! For remapping integer :: nz = 0 !< Vertical dimension of diagnostic integer :: vertical_coordinate_number = 0 !< Index of the corresponding diag_remap_ctrl for this axis group @@ -90,18 +93,21 @@ module MOM_diag_mediator logical :: is_u_point = .false. !< If true, indicates that this axes group is for a u-point located field. logical :: is_v_point = .false. !< If true, indicates that this axes group is for a v-point located field. logical :: is_layer = .false. !< If true, indicates that this axes group is for a layer vertically-located field. - logical :: is_interface = .false. !< If true, indicates that this axes group is for an interface vertically-located field. - logical :: is_native = .true. !< If true, indicates that this axes group is for a native model grid. False for any other - !! grid. Used for rank>2. - logical :: needs_remapping = .false. !< If true, indicates that this axes group is for a intensive layer-located field - !! that must be remapped to these axes. Used for rank>2. - logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled interface-located field - !! that must be interpolated to these axes. Used for rank>2. + logical :: is_interface = .false. !< If true, indicates that this axes group is for an interface + !! vertically-located field. + logical :: is_native = .true. !< If true, indicates that this axes group is for a native model grid. + !! False for any other grid. Used for rank>2. + logical :: needs_remapping = .false. !< If true, indicates that this axes group is for a intensive layer-located + !! field that must be remapped to these axes. Used for rank>2. + logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled + !! interface-located field that must be interpolated to + !! these axes. Used for rank>2. ! For horizontally averaged diagnositcs (applies to 2d and 3d fields only) type(axes_grp), pointer :: xyave_axes => null() !< The associated 1d axes for horizontall area-averaged diagnostics ! ID's for cell_measures integer :: id_area = -1 !< The diag_manager id for area to be used for cell_measure of variables with this axes_grp. - integer :: id_volume = -1 !< The diag_manager id for volume to be used for cell_measure of variables with this axes_grp. + integer :: id_volume = -1 !< The diag_manager id for volume to be used for cell_measure of variables + !! with this axes_grp. ! For masking real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes @@ -133,7 +139,8 @@ module MOM_diag_mediator type(axes_grp), pointer :: axes => null() type(diag_type), pointer :: next => null() !< Pointer to the next diag. real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. - logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). False for intensive (concentrations). + logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). + !! False for intensive (concentrations). end type diag_type !> The following data type a list of diagnostic fields an their variants, @@ -347,7 +354,8 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBL + !! \note Remapping for B points is not yet implemented so needs_remapping is not + !! provided for remap_axesBL call define_axes_group(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%remap_axesBL(i), & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='mean', & @@ -584,21 +592,34 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num type(axes_grp), intent(out) :: axes !< The group of 1D axes integer, optional, intent(in) :: nz !< Number of layers in this diagnostic grid integer, optional, intent(in) :: vertical_coordinate_number !< Index number for vertical coordinate - character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the "cell_methods" attribute in CF convention - character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the "cell_methods" attribute in CF convention - character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct the "cell_methods" attribute in CF convention - logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point located fields - logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point located fields - logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for u-point located fields - logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for v-point located fields - logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is for a layer vertically-located field. - logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group is for an interface vertically-located field. - logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is for a native model grid. False for any other grid. - logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is for a intensive layer-located field - !! that must be remapped to these axes. Used for rank>2. - logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group is for a sampled interface-located field - !! that must be interpolated to these axes. Used for rank>2. - type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally area-average diagnostics + character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct + !! the "cell_methods" attribute in CF convention + logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point + !! located fields + logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point + !! located fields + logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for + !! u-point located fields + logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for + !! v-point located fields + logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is + !! for a layer vertically-located field. + logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group + !! is for an interface vertically-located field. + logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is + !! for a native model grid. False for any other grid. + logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is + !! for a intensive layer-located field that must + !! be remapped to these axes. Used for rank>2. + logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group + !! is for a sampled interface-located field that must + !! be interpolated to these axes. Used for rank>2. + type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally + !! area-average diagnostics ! Local variables integer :: n @@ -1074,7 +1095,8 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then ks = lbound(field,3) ; ke = ubound(field,3) allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2), ks:ke ) ) - ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears not to be necessary. + ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears + ! not to be necessary. isv_c = isv ; jsv_c = jsv if (diag%fms_xyave_diag_id>0) then staggered_in_x = diag%axes%is_u_point .or. diag%axes%is_q_point @@ -1258,39 +1280,50 @@ function get_diag_time_end(diag_cs) get_diag_time_end = diag_cs%time_end end function get_diag_time_end -!> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics derived from one field. +!> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics +!! derived from one field. integer function register_diag_field(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to + !! have no attribute. If present, this overrides the + !! default constructed from the default for !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically + !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs @@ -1378,31 +1411,40 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes + !! for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided + !! with post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for - !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. + !! Use '' to have no attribute. If present, this + !! overrides the default constructed from the default + !! for each individual axis direction. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically + !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs @@ -1462,9 +1504,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, ! For the CMOR variation of the above diagnostic if (present(cmor_field_name)) then ! Fallback values for strings set to "NULL" - posted_cmor_units = "not provided" ! - posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? - posted_cmor_long_name = "not provided" ! + posted_cmor_units = "not provided" ! + posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? + posted_cmor_long_name = "not provided" ! ! If attributes are present for MOM variable names, use them first for the register_diag_field ! call for CMOR verison of the variable @@ -1478,9 +1520,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name fms_id = register_diag_field_expand_axes(module_name, cmor_field_name, axes, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) call attach_cell_methods(fms_id, axes, cm_string, & cell_methods, x_cell_method, y_cell_method, v_cell_method, & @@ -1496,16 +1538,16 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (associated(axes%xyave_axes)) then fms_xyave_id = register_diag_field_expand_axes(module_name, trim(cmor_field_name)//'_xyave', & axes%xyave_axes, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) call attach_cell_methods(fms_xyave_id, axes%xyave_axes, cm_string, & cell_methods, v_cell_method, v_extensive=v_extensive) if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then msg = 'native name is "'//trim(field_name)//'_xyave"' - call log_available_diag(fms_xyave_id>0, module_name, trim(cmor_field_name)//'_xyave', cm_string, & - msg, diag_CS, posted_cmor_long_name, posted_cmor_units, & + call log_available_diag(fms_xyave_id>0, module_name, trim(cmor_field_name)//'_xyave', & + cm_string, msg, diag_CS, posted_cmor_long_name, posted_cmor_units, & posted_cmor_standard_name) endif endif @@ -1522,25 +1564,31 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, end function register_diag_field_expand_cmor -!> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes (axes-group) -!! into handles and conditionally adding an FMS area_id for cell_measures. +!> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes +!! (axes-group) into handles and conditionally adding an FMS area_id for cell_measures. integer function register_diag_field_expand_axes(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided + !! with post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) - logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + logical, optional, intent(in) :: do_not_log !< If true, do not log something + !! (not used in MOM?) + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) ! Local variables integer :: fms_id, area_id, volume_id @@ -1624,8 +1672,10 @@ subroutine add_diag_to_list(diag_cs, dm_id, fms_id, this_diag, axes, module_name integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group integer, intent(in) :: fms_id !< The FMS diag_manager ID for this diagnostic type(diag_type), pointer :: this_diag !< This diagnostic - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field + character(len=*), intent(in) :: module_name !< Name of this module, usually + !! "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of diagnostic character(len=*), intent(in) :: msg !< Message for errors @@ -1645,15 +1695,21 @@ end subroutine add_diag_to_list subroutine attach_cell_methods(id, axes, ostring, cell_methods, & x_cell_method, y_cell_method, v_cell_method, v_extensive) integer, intent(in) :: id !< Handle to diagnostic - type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field character(len=*), intent(out) :: ostring !< The cell_methods strings that would appear in the file - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for - !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. + !! Use '' to have no attribute. If present, this + !! overrides the default constructed from the default + !! for each individual axis direction. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields + !! (vertically integrated). Default/absent for intensive. ! Local variables character(len=9) :: axis_name logical :: x_mean, y_mean, x_sum, y_sum diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index a61c20cf5a..a6ca5db387 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -28,6 +28,7 @@ module MOM_document integer, parameter :: mLen = 1240 ! Length of interface/message strings +!> A structure that controls where the documentation occurs, its veborsity and formatting. type, public :: doc_type ; private integer :: unitAll = -1 ! The open unit number for docFileBase + .all. integer :: unitShort = -1 ! The open unit number for docFileBase + .short. @@ -60,9 +61,13 @@ module MOM_document ! ---------------------------------------------------------------------- +!> This subroutine handles parameter documentation with no value. subroutine doc_param_none(doc, varname, desc, units) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented ! This subroutine handles parameter documentation with no value. integer :: numspc character(len=mLen) :: mesg @@ -80,14 +85,18 @@ subroutine doc_param_none(doc, varname, desc, units) endif end subroutine doc_param_none +!> This subroutine handles parameter documentation for logicals. subroutine doc_param_logical(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - logical, intent(in) :: val - logical, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + logical, intent(in) :: val !< The value of this parameter + logical, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for logicals. character(len=mLen) :: mesg logical :: equalsDefault @@ -118,14 +127,18 @@ subroutine doc_param_logical(doc, varname, desc, units, val, default, & endif end subroutine doc_param_logical +!> This subroutine handles parameter documentation for arrays of logicals. subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - logical, intent(in) :: vals(:) - logical, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + logical, intent(in) :: vals(:) !< The array of values to record + logical, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for arrays of logicals. integer :: i character(len=mLen) :: mesg @@ -164,14 +177,18 @@ subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & endif end subroutine doc_param_logical_array +!> This subroutine handles parameter documentation for integers. subroutine doc_param_int(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - integer, intent(in) :: val - integer, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + integer, intent(in) :: val !< The value of this parameter + integer, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for integers. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -196,14 +213,18 @@ subroutine doc_param_int(doc, varname, desc, units, val, default, & endif end subroutine doc_param_int +!> This subroutine handles parameter documentation for arrays of integers. subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - integer, intent(in) :: vals(:) - integer, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + integer, intent(in) :: vals(:) !< The array of values to record + integer, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for arrays of integers. integer :: i character(len=mLen) :: mesg @@ -235,12 +256,16 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & end subroutine doc_param_int_array +!> This subroutine handles parameter documentation for reals. subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - real, intent(in) :: val - real, optional, intent(in) :: default - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + real, intent(in) :: val !< The value of this parameter + real, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for reals. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -265,12 +290,16 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara endif end subroutine doc_param_real +!> This subroutine handles parameter documentation for arrays of reals. subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - real, intent(in) :: vals(:) - real, optional, intent(in) :: default - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + real, intent(in) :: vals(:) !< The array of values to record + real, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for arrays of reals. integer :: i character(len=mLen) :: mesg @@ -299,14 +328,19 @@ subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debugg end subroutine doc_param_real_array +!> This subroutine handles parameter documentation for character strings. subroutine doc_param_char(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - character(len=*), intent(in) :: val - character(len=*), optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + character(len=*), intent(in) :: val !< The value of the parameter + character(len=*), & + optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for character strings. character(len=mLen) :: mesg logical :: equalsDefault @@ -330,10 +364,12 @@ subroutine doc_param_char(doc, varname, desc, units, val, default, & end subroutine doc_param_char +!> This subroutine handles documentation for opening a parameter block. subroutine doc_openBlock(doc, blockName, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: blockName - character(len=*), optional, intent(in) :: desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: blockName !< The name of the parameter block being opened + character(len=*), optional, intent(in) :: desc !< A description of the parameter block being opened ! This subroutine handles documentation for opening a parameter block. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -353,9 +389,11 @@ subroutine doc_openBlock(doc, blockName, desc) doc%blockPrefix = trim(doc%blockPrefix)//trim(blockName)//'%' end subroutine doc_openBlock +!> This subroutine handles documentation for closing a parameter block. subroutine doc_closeBlock(doc, blockName) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: blockName + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: blockName !< The name of the parameter block being closed ! This subroutine handles documentation for closing a parameter block. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -377,14 +415,18 @@ subroutine doc_closeBlock(doc, blockName) endif end subroutine doc_closeBlock +!> This subroutine handles parameter documentation for time-type variables. subroutine doc_param_time(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - type(time_type), intent(in) :: val - type(time_type), optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + type(time_type), intent(in) :: val !< The value of the parameter + type(time_type), optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for time-type variables. ! ### This needs to be written properly! integer :: numspc @@ -407,14 +449,17 @@ subroutine doc_param_time(doc, varname, desc, units, val, default, & end subroutine doc_param_time +!> This subroutine writes out the message and description to the documetation files. subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & layoutParam, debuggingParam) - type(doc_type), intent(in) :: doc - character(len=*), intent(in) :: vmesg, desc - logical, optional, intent(in) :: valueWasDefault - integer, optional, intent(in) :: indent - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), intent(in) :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: vmesg !< A message with the parameter name, units, and default value. + character(len=*), intent(in) :: desc !< A description of the parameter being documented + logical, optional, intent(in) :: valueWasDefault !< If true, this parameter has its default value + integer, optional, intent(in) :: indent !< An amount by which to indent this message + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. character(len=mLen) :: mesg integer :: start_ind = 1, end_ind, indnt, tab, len_tab, len_nl logical :: all, short, layout, debug @@ -472,8 +517,9 @@ end subroutine writeMessageAndDesc ! ---------------------------------------------------------------------- +!> This function returns a string with a real formatted like '(G)' function real_string(val) - real, intent(in) :: val + real, intent(in) :: val !< The value being written into a string character(len=32) :: real_string ! This function returns a string with a real formatted like '(G)' integer :: len, ind @@ -523,10 +569,14 @@ function real_string(val) real_string = adjustl(real_string) end function real_string -function real_array_string(vals,sep) - character(len=1320) :: real_array_string - real, intent(in) :: vals(:) - character(len=*), optional :: sep +!> Returns a character string of a comma-separated, compact formatted, reals +!> e.g. "1., 2., 5*3., 5.E2", that give the list of values. +function real_array_string(vals, sep) + character(len=1320) :: real_array_string !< The output string listing vals + real, intent(in) :: vals(:) !< The array of values to record + character(len=*), & + optional, intent(in) :: sep !< The separator between successive values, + !! by default it is ', '. ! Returns a character string of a comma-separated, compact formatted, reals ! e.g. "1., 2., 5*3., 5.E2" ! Local variables @@ -562,9 +612,10 @@ function real_array_string(vals,sep) enddo end function real_array_string +!> This function tests whether a real value is encoded in a string. function testFormattedFloatIsReal(str, val) - character(len=*), intent(in) :: str - real, intent(in) :: val + character(len=*), intent(in) :: str !< The string that match val + real, intent(in) :: val !< The value being tested logical :: testFormattedFloatIsReal ! Local variables real :: scannedVal @@ -577,25 +628,31 @@ function testFormattedFloatIsReal(str, val) endif end function testFormattedFloatIsReal +!> This function returns a string with an integer formatted like '(I)' function int_string(val) - integer, intent(in) :: val + integer, intent(in) :: val !< The value being written into a string character(len=24) :: int_string ! This function returns a string with an integer formatted like '(I)' write(int_string, '(i24)') val int_string = adjustl(int_string) end function int_string +!> This function returns a string with an logical formatted like '(L)' function logical_string(val) - logical, intent(in) :: val + logical, intent(in) :: val !< The value being written into a string character(len=24) :: logical_string ! This function returns a string with an logical formatted like '(L)' write(logical_string, '(l24)') val logical_string = adjustl(logical_string) end function logical_string +!> This function returns a string for formatted parameter assignment function define_string(doc,varName,valString,units) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varName, valString, units + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varName !< The name of the parameter being documented + character(len=*), intent(in) :: valString !< A string containing the value of the parameter + character(len=*), intent(in) :: units !< The units of the parameter being documented character(len=mLen) :: define_string ! This function returns a string for formatted parameter assignment integer :: numSpaces @@ -610,9 +667,12 @@ function define_string(doc,varName,valString,units) if (len_trim(units) > 0) define_string = trim(define_string)//" ["//trim(units)//"]" end function define_string +!> This function returns a string for formatted false logicals function undef_string(doc,varName,units) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varName, units + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varName !< The name of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented character(len=mLen) :: undef_string ! This function returns a string for formatted false logicals integer :: numSpaces @@ -630,9 +690,12 @@ end function undef_string ! ---------------------------------------------------------------------- +!> This subroutine handles the module documentation subroutine doc_module(doc, modname, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: modname, desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: modname !< The name of the module being documented + character(len=*), intent(in) :: desc !< A description of the module being documented ! This subroutine handles the module documentation character(len=mLen) :: mesg @@ -646,18 +709,26 @@ subroutine doc_module(doc, modname, desc) endif end subroutine doc_module +!> This subroutine handles the subroutine documentation subroutine doc_subroutine(doc, modname, subname, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: modname, subname, desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: modname !< The name of the module being documented + character(len=*), intent(in) :: subname !< The name of the subroutine being documented + character(len=*), intent(in) :: desc !< A description of the subroutine being documented ! This subroutine handles the subroutine documentation if (.not. (is_root_pe() .and. associated(doc))) return call open_doc_file(doc) end subroutine doc_subroutine +!> This subroutine handles the function documentation subroutine doc_function(doc, modname, fnname, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: modname, fnname, desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: modname !< The name of the module being documented + character(len=*), intent(in) :: fnname !< The name of the function being documented + character(len=*), intent(in) :: desc !< A description of the function being documented ! This subroutine handles the function documentation if (.not. (is_root_pe() .and. associated(doc))) return call open_doc_file(doc) @@ -667,9 +738,18 @@ end subroutine doc_function ! ---------------------------------------------------------------------- subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging) - character(len=*), intent(in) :: docFileBase - type(doc_type), pointer :: doc - logical, optional, intent(in) :: minimal, complete, layout, debugging + character(len=*), intent(in) :: docFileBase !< The base file name for this set of parameters, + !! for example MOM_parameter_doc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + logical, optional, intent(in) :: minimal !< If present and true, write out the files (.short) documenting + !! those parameters that do not take on their default values. + logical, optional, intent(in) :: complete !< If present and true, write out the (.all) files documenting all + !! parameters + logical, optional, intent(in) :: layout !< If present and true, write out the (.layout) files documenting + !! the layout parameters + logical, optional, intent(in) :: debugging !< If present and true, write out the (.debugging) files documenting + !! the debugging parameters ! Arguments: docFileBase - The name of the doc file. ! (inout) doc - The doc_type to populate. @@ -685,8 +765,12 @@ subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging) end subroutine doc_init +!< This subroutine allocates and populates a structure that controls where the +!! documentation occurs and its formatting, and opens up the files controlled +!! by this structure subroutine open_doc_file(doc) - type(doc_type), pointer :: doc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting logical :: opened, new_file integer :: ios @@ -781,6 +865,7 @@ subroutine open_doc_file(doc) end subroutine open_doc_file +! Find an unused unit number, returning >0 if found, and triggering a FATAL error if not. function find_unused_unit_number() ! Find an unused unit number. ! Returns >0 if found. FATAL if not. @@ -794,8 +879,11 @@ function find_unused_unit_number() "doc_init failed to find an unused unit number.") end function find_unused_unit_number +!< This subroutine closes the the files controlled by doc, and sets flags in +!! doc to indicate that parameterization is no longer permitted. subroutine doc_end(doc) - type(doc_type), pointer :: doc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting type(link_msg), pointer :: this, next if (.not.associated(doc)) return @@ -832,9 +920,13 @@ end subroutine doc_end ! ----------------------------------------------------------------------------- +!> Returns true if documentation has already been written function mesgHasBeenDocumented(doc,varName,mesg) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varName, mesg + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varName !< The name of the parameter being documented + character(len=*), intent(in) :: mesg !< A message with parameter values, defaults, and descriptions + !! to compare with the message that was written previously logical :: mesgHasBeenDocumented ! Returns true if documentation has already been written type(link_msg), pointer :: newLink, this, last diff --git a/src/framework/MOM_error_handler.F90 b/src/framework/MOM_error_handler.F90 index 48edffc1f6..e1a85b52c4 100644 --- a/src/framework/MOM_error_handler.F90 +++ b/src/framework/MOM_error_handler.F90 @@ -46,6 +46,7 @@ module MOM_error_handler contains +!> This returns .true. if the current PE is the root PE. function is_root_pe() ! This returns .true. if the current PE is the root PE. logical :: is_root_pe @@ -54,10 +55,12 @@ function is_root_pe() return end function is_root_pe +!> This provides a convenient interface for writing an informative comment. subroutine MOM_mesg(message, verb, all_print) - character(len=*), intent(in) :: message - integer, optional, intent(in) :: verb - logical, optional, intent(in) :: all_print + character(len=*), intent(in) :: message !< A message to write out + integer, optional, intent(in) :: verb !< A level of verbosity for this message + logical, optional, intent(in) :: all_print !< If present and true, any PEs are + !! able to write this message. ! This provides a convenient interface for writing an informative comment. integer :: verb_msg logical :: write_msg @@ -70,10 +73,13 @@ subroutine MOM_mesg(message, verb, all_print) end subroutine MOM_mesg +!> This provides a convenient interface for writing an mpp_error message +!! with run-time filter based on a verbosity. subroutine MOM_error(level, message, all_print) - integer, intent(in) :: level - character(len=*), intent(in) :: message - logical, optional, intent(in) :: all_print + integer, intent(in) :: level !< The verbosity level of this message + character(len=*), intent(in) :: message !< A message to write out + logical, optional, intent(in) :: all_print !< If present and true, any PEs are + !! able to write this message. ! This provides a convenient interface for writing an mpp_error message ! with run-time filter based on a verbosity. logical :: write_msg @@ -93,8 +99,9 @@ subroutine MOM_error(level, message, all_print) end select end subroutine MOM_error +!> This subroutine sets the level of verbosity filtering MOM error messages subroutine MOM_set_verbosity(verb) - integer, intent(in) :: verb + integer, intent(in) :: verb !< A level of verbosity to set character(len=80) :: msg if (verb>0 .and. verb<10) then verbosity=verb @@ -104,13 +111,16 @@ subroutine MOM_set_verbosity(verb) endif end subroutine MOM_set_verbosity +!> This subroutine gets the level of verbosity filtering MOM error messages function MOM_get_verbosity() integer :: MOM_get_verbosity MOM_get_verbosity = verbosity end function MOM_get_verbosity +!> This tests whether the level of verbosity filtering MOM error messages is +!! sufficient to write a message of verbosity level verb function MOM_verbose_enough(verb) - integer, intent(in) :: verb + integer, intent(in) :: verb !< A level of verbosity to test logical :: MOM_verbose_enough MOM_verbose_enough = (verbosity >= verb) end function MOM_verbose_enough @@ -124,8 +134,8 @@ end function callTree_showQuery !> Writes a message about entering a subroutine if call tree reporting is active subroutine callTree_enter(mesg,n) - character(len=*) :: mesg !< Message to write - integer, optional :: n !< An optional integer to write at end of message + character(len=*), intent(in) :: mesg !< Message to write + integer, optional, intent(in) :: n !< An optional integer to write at end of message ! Local variables character(len=8) :: nAsString callTreeIndentLevel = callTreeIndentLevel + 1 @@ -155,8 +165,8 @@ end subroutine callTree_leave !> Writes a message about reaching a milestone if call tree reporting is active subroutine callTree_waypoint(mesg,n) - character(len=*) :: mesg !< Message to write - integer, optional :: n !< An optional integer to write at end of message + character(len=*), intent(in) :: mesg !< Message to write + integer, optional, intent(in) :: n !< An optional integer to write at end of message ! Local variables character(len=8) :: nAsString if (callTreeIndentLevel<0) write(0,*) 'callTree_waypoint: error callTreeIndentLevel=',callTreeIndentLevel,trim(mesg) diff --git a/src/framework/MOM_get_input.F90 b/src/framework/MOM_get_input.F90 index 2687579750..de75e9713b 100644 --- a/src/framework/MOM_get_input.F90 +++ b/src/framework/MOM_get_input.F90 @@ -38,7 +38,7 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename, character(len=*), optional, intent(in) :: default_input_filename !< If present, is the value assumed for !! input_filename if input_filename is not listed !! in the namelist MOM_input_nml. - integer, intent(in), optional :: ensemble_num !< The ensemble id of the current member + integer, optional, intent(in) :: ensemble_num !< The ensemble id of the current member ! Local variables integer, parameter :: npf = 5 ! Maximum number of parameter files character(len=240) :: & diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 1d692cf393..db65a9504c 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -91,6 +91,11 @@ subroutine myStats(array, missing, is, ie, js, je, k, mesg) endif end subroutine myStats + +!> Use ICE-9 algorithm to populate points (fill=1) with +!! valid data (good=1). If no information is available, +!! Then use a previous guess (prev). Optionally (smooth) +!! blend the filled points to achieve a more desirable result. subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug,debug) ! !# Use ICE-9 algorithm to populate points (fill=1) with @@ -105,19 +110,29 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug ! use MOM_coms, only : sum_across_PEs - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: aout - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: good !< Valid data mask for incoming array - !! (1==good data; 0==missing data). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: fill !< Same shape array of points which need - !! filling (1==please fill;0==leave - !! it alone). - real, dimension(SZI_(G),SZJ_(G)), optional, & - intent(in) :: prev !< First guess where isolated holes exist. - logical, intent(in), optional :: smooth - integer, intent(in), optional :: num_pass - real, intent(in), optional :: relc,crit - logical, intent(in), optional :: keep_bug, debug + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: aout !< The array with missing values to fill + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: good !< Valid data mask for incoming array + !! (1==good data; 0==missing data). + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: fill !< Same shape array of points which need + !! filling (1==please fill;0==leave + !! it alone). + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: prev !< First guess where isolated holes exist. + logical, optional, intent(in) :: smooth !< If present and true, apply a number of + !! Laplacian smoothing passes to the interpolated data + integer, optional, intent(in) :: num_pass !< The maximum number of smoothing passes + !! to apply. + real, optional, intent(in) :: relc !< A nondimensional relaxation coefficient for + !! the smoothing passes. + real, optional, intent(in) :: crit !< A minimal value for changes in the array + !! at which point the smoothing is stopped. + logical, optional, intent(in) :: keep_bug !< Use an algorithm with a bug that dates + !! to the "sienna" code release. + logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. real, dimension(SZI_(G),SZJ_(G)) :: b,r @@ -229,9 +244,12 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug do j=js,je do i=is,ie if (fill(i,j) .eq. 1) then - east=max(good(i+1,j),fill(i+1,j));west=max(good(i-1,j),fill(i-1,j)) - north=max(good(i,j+1),fill(i,j+1));south=max(good(i,j-1),fill(i,j-1)) - r(i,j) = relax_coeff*(south*aout(i,j-1)+north*aout(i,j+1)+west*aout(i-1,j)+east*aout(i+1,j) - (south+north+west+east)*aout(i,j)) + east=max(good(i+1,j),fill(i+1,j)) ; west=max(good(i-1,j),fill(i-1,j)) + north=max(good(i,j+1),fill(i,j+1)) ; south=max(good(i,j-1),fill(i,j-1)) + !### Appropriate parentheses should be added here, but they will change answers. + r(i,j) = relax_coeff*(south*aout(i,j-1)+north*aout(i,j+1) + & + west*aout(i-1,j)+east*aout(i+1,j) - & + (south+north+west+east)*aout(i,j)) else r(i,j) = 0. endif @@ -273,9 +291,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, !! local model grid and native vertical levels. real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. - real, intent(out) :: missing_value - logical, intent(in) :: reentrant_x, tripolar_n - logical, intent(in), optional :: homogenize + real, intent(out) :: missing_value !< The missing value in the returned array. + logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction + logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid + logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data + !! to produce perfectly "flat" initial conditions real, dimension(:,:), allocatable :: tr_in,tr_inp !< A 2-d array for holding input data on !! native horizontal grid and extended grid @@ -587,9 +607,11 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t !! local model grid and native vertical levels. real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. - real, intent(out) :: missing_value - logical, intent(in) :: reentrant_x, tripolar_n - logical, intent(in), optional :: homogenize + real, intent(out) :: missing_value !< The missing value in the returned array. + logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction + logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid + logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data + !! to produce perfectly "flat" initial conditions real, dimension(:,:), allocatable :: tr_in,tr_inp !< A 2-d array for holding input data on !! native horizontal grid and extended grid diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index d708fcdf27..54ce188bb9 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -227,8 +227,9 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit if ((use_layer .or. use_int) .and. .not.present(GV)) call MOM_error(FATAL, & "create_file: A vertical grid type is required to create a file with a vertical coordinate.") -! Specify all optional arguments to mpp_write_meta: name, units, longname, cartesian, calendar, sense, domain, data, min) -! Otherwise if optional arguments are added to mpp_write_meta the compiler may (and in case of GNU is) get confused and crash. +! Specify all optional arguments to mpp_write_meta: name, units, longname, cartesian, calendar, sense, +! domain, data, min). Otherwise if optional arguments are added to mpp_write_meta the compiler may +! (and in case of GNU does) get confused and crash. if (use_lath) & call mpp_write_meta(unit, axis_lath, name="lath", units=y_axis_units, longname="Latitude", & cartesian='Y', domain = y_domain, data=gridLatT(jsg:jeg)) @@ -635,19 +636,19 @@ end function var_desc !! All arguments are optional, except the vardesc type to be modified. subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & cmor_field_name, cmor_units, cmor_longname, conversion, caller) - type(vardesc), intent(inout) :: vd !< vardesc type that is modified - character(len=*), optional, intent(in) :: name !< name of variable - character(len=*), optional, intent(in) :: units !< units of variable - character(len=*), optional, intent(in) :: longname !< long name of variable - character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable - character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable - character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 - character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name - character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable - character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name - real , optional, intent(in) :: conversion !< for unit conversions, such as needed to - !! convert from intensive to extensive - character(len=*), optional, intent(in) :: caller !< calling routine? + type(vardesc), intent(inout) :: vd !< vardesc type that is modified + character(len=*), optional, intent(in) :: name !< name of variable + character(len=*), optional, intent(in) :: units !< units of variable + character(len=*), optional, intent(in) :: longname !< long name of variable + character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable + character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable + character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 + character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name + character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable + character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name + real , optional, intent(in) :: conversion !< for unit conversions, such as needed + !! to convert from intensive to extensive + character(len=*), optional, intent(in) :: caller !< calling routine? character(len=120) :: cllr cllr = "mod_vardesc" diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index c0f3ba2b28..aa9b11bda6 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -149,7 +149,9 @@ function left_reals(r,sep) ! Arguments character(len=1320) :: left_reals real, intent(in) :: r(:) - character(len=*), optional :: sep + character(len=*), optional, intent(in) :: sep !< The separator between + !! successive values, by default it is ', '. + ! Local variables integer :: j, n, b, ns logical :: doWrite diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index efa74e561e..52436cf827 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1,6 +1,6 @@ !> Implements the thermodynamic aspects of ocean / ice-shelf interactions, -! along with a crude placeholder for a later implementation of full -! ice shelf dynamics, all using the MOM framework and coding style. +!! along with a crude placeholder for a later implementation of full +!! ice shelf dynamics, all using the MOM framework and coding style. module MOM_ice_shelf ! This file is part of MOM6. See LICENSE.md for the license. @@ -150,7 +150,8 @@ module MOM_ice_shelf !!! OVS !!! t_boundary_values => NULL(), & - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal law exponent + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - + ! exact form depends on basal law exponent ! and/or whether flow is "hybridized" a la Goldberg 2011 taub_beta_eff_lower_tri => NULL(), & taub_beta_eff_upper_tri => NULL(), & @@ -233,7 +234,8 @@ module MOM_ice_shelf ! ~ once a day (maybe longer) because it will depend on ocean values ! that are averaged over this time interval, and the solve will begin ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; the counter will have to be stored + integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; + ! the counter will have to be stored integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) @@ -347,9 +349,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) type(surface), intent(inout) :: state !< structure containing fields that !!describe the surface state of the ocean type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< structure containing pointers to - !!any possible forcing fields. - !!Unused fields have NULL ptrs. + type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible + !! thermodynanamic or mass-flux forcing fields. type(time_type), intent(in) :: Time !< Start time of the fluxes. real, intent(in) :: time_step !< Length of time over which !! these fluxes will be applied, in s. @@ -411,7 +412,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) character(4) :: stepnum character(2) :: procnum - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, parameter :: c2_3 = 2.0/3.0 integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve real, parameter :: rho_fw = 1000.0 ! fresh water density @@ -813,7 +814,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 if (CS%GL_couple .and. .not. CS%solo_ice_sheet) then - call update_OD_ffrac (CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, CS%time_step, CS%velocity_update_time_step) + call update_OD_ffrac(CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & + CS%time_step, CS%velocity_update_time_step) else call update_OD_ffrac_uncoupled (CS) endif @@ -864,10 +866,10 @@ end subroutine shelf_calc_flux !> Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting subroutine change_thickness_using_melt(CS,G,time_step, fluxes) - type(ocean_grid_type), intent(inout) :: G - type(ice_shelf_CS), intent(inout) :: CS - real, intent(in) :: time_step - type(forcing), intent(inout) :: fluxes + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + real, intent(in) :: time_step + type(forcing), intent(inout) :: fluxes ! locals integer :: i, j @@ -952,6 +954,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) real, dimension(:,:), allocatable, target :: last_area_shelf_h !< Ice shelf area ! at at previous time (Time-dt), m^2 + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real, parameter :: rho_fw = 1000.0 ! fresh water density integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -962,46 +965,33 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! bottom boundary layer. Together these give the TKE source and ! vertical decay scale. if (CS%shelf_mass_is_dynamic) then - do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) - enddo ; enddo - !do I=isd,ied-1 ; do j=isd,jed - do j=jsd,jed ; do i=isd,ied-1 ! ### changed stride order; i->ied-1? + do j=jsd,jed ; do I=isd,ied-1 forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) - !### Either the min here or the max below must be wrong, but is either right? -RWH - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo - do j=jsd,jed-1 ; do i=isd,ied ! ### change stride order; j->jed-1? - !do i=isd,ied ; do J=isd,jed-1 + do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) - !### Either the max here or the min above must be wrong, but is either right? -RWH - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - else - ! This is needed because rigidity is potentially modified in the coupler. Reset - ! in the ice shelf cavity: MJH - - do j=jsd,jed ; do i=isd,ied-1 ! changed stride - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) - enddo ; enddo - - do j=jsd,jed-1 ; do i=isd,ied ! changed stride - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) - enddo ; enddo endif + ! For various reasons, forces%rigidity_ice_[uv] is always updated here, and + ! it has been zeroed out where IOB is translated to forces. + kv_rho_ice = CS%kv_ice / CS%density_ice + do j=js,je ; do I=is-1,ie + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + enddo ; enddo + do J=js-1,je ; do i=is,ie + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + enddo ; enddo + if (CS%debug) then if (associated(state%taux_shelf)) then call uchksum(state%taux_shelf, "taux_shelf", G%HI, haloshift=0) @@ -1018,55 +1008,62 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then call pass_vector(state%taux_shelf, state%tauy_shelf, G%domain, TO_ALL, CGRID_NE) endif + ! GMM: melting is computed using ustar_shelf (and not ustar), which has already + ! been passed, I so believe we do not need to update fluxes%ustar. +! do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then + ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. + ! taux2 = 0.0 ; tauy2 = 0.0 + ! asu1 = forces%frac_shelf_u(I-1,j) * G%areaCu(I-1,j) + ! asu2 = forces%frac_shelf_u(I,j) * G%areaCu(I,j) + ! asv1 = forces%frac_shelf_v(i,J-1) * G%areaCv(i,J-1) + ! asv2 = forces%frac_shelf_v(i,J) * G%areaCv(i,J) + ! if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & + ! taux2 = (asu1 * state%taux_shelf(I-1,j)**2 + & + ! asu2 * state%taux_shelf(I,j)**2 ) / (asu1 + asu2) + ! if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) & + ! tauy2 = (asv1 * state%tauy_shelf(i,J-1)**2 + & + ! asv2 * state%tauy_shelf(i,J)**2 ) / (asv1 + asv2) + + !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) +! endif ; enddo ; enddo - if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir = 0.0 - if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif = 0.0 - if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir = 0.0 - if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif = 0.0 + if (CS%shelf_mass_is_dynamic) then + do j=jsd,jed ; do i=isd,ied + if (G%areaT(i,j) > 0.0) & + fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) * G%IareaT(i,j) + enddo ; enddo + endif - do j=G%jsc,G%jec ; do i=G%isc,G%iec + do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then frac_area = fluxes%frac_shelf_h(i,j) - if (frac_area > 0.0) then - ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. - taux2 = 0.0 ; tauy2 = 0.0 - asu1 = forces%frac_shelf_u(i-1,j) * (G%areaT(i-1,j) + G%areaT(i,j)) ! G%dxdy_u(i-1,j) - asu2 = forces%frac_shelf_u(i,j) * (G%areaT(i,j) + G%areaT(i+1,j)) ! G%dxdy_u(i,j) - asv1 = forces%frac_shelf_v(i,j-1) * (G%areaT(i,j-1) + G%areaT(i,j)) ! G%dxdy_v(i,j-1) - asv2 = forces%frac_shelf_v(i,j) * (G%areaT(i,j) + G%areaT(i,j+1)) ! G%dxdy_v(i,j) - if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & - taux2 = (asu1 * state%taux_shelf(i-1,j)**2 + & - asu2 * state%taux_shelf(i,j)**2 ) / (asu1 + asu2) - if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) & - tauy2 = (asv1 * state%tauy_shelf(i,j-1)**2 + & - asv2 * state%tauy_shelf(i,j)**2 ) / (asv1 + asv2) - - ! GMM: melting is computed using ustar_shelf (and not ustar), which has already - ! been passed, so believe we do not need to update fluxes%ustar. - !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) - - if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 - if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 - if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 - if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 - if (associated(fluxes%lprec)) then - if (CS%lprec(i,j) > 0.0 ) then - fluxes%lprec(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor - else - fluxes%lprec(i,j) = 0.0 - fluxes%evap(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor - endif + if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 + if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir(i,j) = 0.0 + if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif(i,j) = 0.0 + if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir(i,j) = 0.0 + if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif(i,j) = 0.0 + if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 + if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 + if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 + if (associated(fluxes%lprec)) then + if (CS%lprec(i,j) > 0.0) then + fluxes%lprec(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor + else + fluxes%lprec(i,j) = 0.0 + fluxes%evap(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor endif + endif - if (associated(fluxes%sens)) fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor - if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor - if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - ! Same for IOB%p - if (associated(fluxes%p_surf_full) ) fluxes%p_surf_full(i,j) = & - frac_area * CS%g_Earth * CS%mass_shelf(i,j) + if (associated(fluxes%sens)) & + fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor + if (associated(fluxes%salt_flux)) & + fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor + if (associated(fluxes%p_surf)) & + fluxes%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) + if (associated(fluxes%p_surf_full)) & + fluxes%p_surf_full(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - endif - enddo ; enddo + endif ; enddo ; enddo ! keep sea level constant by removing mass in the sponge ! region (via virtual precip, vprec). Apply additional @@ -1075,6 +1072,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! This is needed for some of the ISOMIP+ experiments. if (CS%constant_sea_level) then + !### This code has lots of problems with hard coded constants and the use of + !### of non-reproducing sums. I needs to be refactored. -RWH if (.not. associated(fluxes%salt_flux)) allocate(fluxes%salt_flux(ie,je)) if (.not. associated(fluxes%vprec)) allocate(fluxes%vprec(ie,je)) @@ -1136,7 +1135,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) delta_mass_shelf = 0.0 endif else ! ice shelf mass does not change - delta_mass_shelf = 0.0 + delta_mass_shelf = 0.0 endif call mpp_sum(mean_melt_flux) @@ -1158,25 +1157,10 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (CS%DEBUG) then if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,CS%time_step call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) - endif + endif endif!constant_sea_level - ! If the shelf mass is changing, the forces%rigidity_ice_[uv] needs to be - ! updated here. - - if (CS%shelf_mass_is_dynamic) then - do j=G%jsc,G%jec ; do i=G%isc-1,G%iec - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) - enddo ; enddo - - do j=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) - enddo ; enddo - endif - end subroutine add_shelf_flux @@ -1185,7 +1169,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ocean_grid_type), pointer :: ocn_grid type(time_type), intent(inout) :: Time - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(diag_ctrl), target, intent(in) :: diag type(forcing), optional, intent(inout) :: fluxes type(mech_forcing), optional, intent(inout) :: forces @@ -1197,6 +1181,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(vardesc) :: vd type(dyn_horgrid_type), pointer :: dG => NULL() real :: cdrag, drag_bg_vel + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. logical :: new_sim, save_IC, var_force !This include declares and sets the variable "version". #include "version_variable.h" @@ -1806,23 +1791,22 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(forces) .and. .not. CS%solo_ice_sheet) then - do j=jsd,jed ; do i=isd,ied-1 + kv_rho_ice = CS%kv_ice / CS%density_ice + do j=js,je ; do i=is-1,ie forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo - - - do j=jsd,jed-1 ; do i=isd,ied + do j=js-1,je ; do i=is,ie forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo endif @@ -1973,10 +1957,10 @@ end subroutine initialize_ice_shelf !> Initializes shelf mass based on three options (file, zero and user) subroutine initialize_shelf_mass(G, param_file, CS, new_sim) - type(ocean_grid_type), intent(in) :: G + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ice_shelf_CS), pointer :: CS - logical, optional :: new_sim + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted integer :: i, j, is, ie, js, je logical :: read_shelf_area, new_sim_2 @@ -1986,11 +1970,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) character(len=40) :: mdl = "MOM_ice_shelf" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (.not. present(new_sim)) then - new_sim_2 = .true. - else - new_sim_2 = .false. - endif + new_sim_2 = .true. ; if (present(new_sim)) new_sim_2 = new_sim call get_param(param_file, mdl, "ICE_SHELF_CONFIG", config, & "A string that specifies how the ice shelf is \n"//& @@ -2062,8 +2042,8 @@ end subroutine initialize_shelf_mass !> Updates the ice shelf mass using data from a file. subroutine update_shelf_mass(G, CS, Time, fluxes) - type(ocean_grid_type), intent(inout) :: G - type(ice_shelf_CS), pointer :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(time_type), intent(in) :: Time type(forcing), intent(inout) :: fluxes @@ -2071,12 +2051,6 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - ! first, zero out fluxes applied during previous time step - do j=js,je; do i=is,ie - - - enddo; enddo - call time_interp_external(CS%id_read_mass, Time, CS%mass_shelf) do j=js,je ; do i=is,ie @@ -2124,7 +2098,7 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) end subroutine update_shelf_mass subroutine initialize_diagnostic_fields (CS, FE, Time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure integer :: FE type(time_type), intent(in) :: Time @@ -2198,7 +2172,7 @@ end subroutine ice_shelf_save_restart subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate type(time_type), intent(in) :: Time @@ -2315,7 +2289,7 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v integer, intent(in) :: FE integer, intent(out) :: iters @@ -2673,7 +2647,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) end subroutine ice_shelf_solve_outer subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: taudx, taudy, H_node real, dimension(:,:),intent(in) :: float_cond @@ -3119,7 +3093,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 real, dimension(:,:), intent(inout) :: h_after_uflux @@ -3221,8 +3195,8 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%thickness_boundary_values(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh @@ -3269,8 +3243,8 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh @@ -3331,13 +3305,15 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 @@ -3358,7 +3334,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h_after_uflux real, dimension(:,:), intent(inout) :: h_after_vflux @@ -3452,8 +3428,8 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid @@ -3500,8 +3476,8 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) @@ -3551,12 +3527,14 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v endif if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 endif @@ -3571,7 +3549,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v end subroutine ice_shelf_advect_thickness_y subroutine shelf_advance_front (CS, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:,:), intent(inout) :: flux_enter ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, @@ -3764,7 +3742,7 @@ end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask type(ocean_grid_type), pointer :: G integer :: i,j @@ -3786,7 +3764,7 @@ subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask, calve_mask type(ocean_grid_type), pointer :: G @@ -3809,7 +3787,7 @@ subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) end subroutine calve_to_mask subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(in) :: OD real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: TAUD_X, TAUD_Y integer, intent(in) :: FE @@ -3838,7 +3816,8 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off G => CS%grid @@ -4012,28 +3991,35 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) endif - if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then ! left face of the cell is at a stress boundary - ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated pressure on either side of the face + if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then + ! left face of the cell is at a stress boundary + ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated + ! pressure on either side of the face ! on the ice side, it is rho g h^2 / 2 ! on the ocean side, it is rhow g (delta OD)^2 / 2 - ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation is not above the base of the - ! ice in the current cell - taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val ! note negative sign is due to direction of normal vector + ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation + ! is not above the base of the ice in the current cell + + ! note negative sign due to direction of normal vector + taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val endif - if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then ! right face of the cell is at a stress boundary + if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then + ! right face of the cell is at a stress boundary taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val endif - if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then ! south face of the cell is at a stress boundary + if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then + ! south face of the cell is at a stress boundary taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val endif - if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then ! north face of the cell is at a stress boundary - taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign is due to direction of normal vector + if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then + ! north face of the cell is at a stress boundary + taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val endif @@ -4049,9 +4035,9 @@ end subroutine calc_shelf_driving_stress subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) type(time_type), intent(in) :: Time - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: input_flux, input_thick - logical, optional :: new_sim + logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function @@ -4066,7 +4052,8 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) v_boundary_values, & u_face_mask, v_face_mask, hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off real :: A, n, ux, uy, vx, vy, eps_min, domain_width @@ -4428,7 +4415,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) -! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) +! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) & +! print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) !endif enddo ; enddo @@ -4445,7 +4433,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) - !if ( (iphi.eq.1) .and. (jphi.eq.1)) print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) + !if ( (iphi.eq.1) .and. (jphi.eq.1)) 8 + ! print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) endif enddo ; enddo endif @@ -4499,8 +4488,8 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat uq = 0 ; vq = 0 do k=1,2 do l=1,2 - !Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) - !Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) + !Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) + !Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) uq = uq + Phisub(i,j,k,l,qx,qy) * U(k,l) ; vq = vq + Phisub(i,j,k,l,qx,qy) * V(k,l) enddo enddo @@ -4508,7 +4497,8 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq - ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) + ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) & + print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) endif @@ -4523,7 +4513,7 @@ end subroutine CG_action_subgrid_basal_bilinear subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (:,:), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning @@ -4683,7 +4673,7 @@ end subroutine matrix_diagonal_triangle subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: H_node real :: dens_ratio real, dimension (:,:), intent(in) :: float_cond @@ -4864,7 +4854,7 @@ end subroutine CG_diagonal_subgrid_basal_bilinear subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (:,:), intent(inout) :: u_boundary_contr, v_boundary_contr ! this will be a per-setup function. the boundary values of thickness and velocity @@ -5038,11 +5028,12 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar end subroutine apply_boundary_values_triangle -subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, dens_ratio, u_boundary_contr, v_boundary_contr) +subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, dens_ratio, & + u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time real, dimension (:,:,:,:,:,:),pointer:: Phisub - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: H_node real, dimension (:,:), intent (in) :: float_cond real :: dens_ratio @@ -5218,7 +5209,7 @@ subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, end subroutine apply_boundary_values_bilinear subroutine calc_shelf_visc_triangular (CS,u,v) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: u, v ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is @@ -5236,7 +5227,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed + integer :: iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh G => CS%grid @@ -5282,7 +5274,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) ux = (u(i,j)-u(i-1,j)) / dxh vx = (v(i,j)-v(i-1,j)) / dxh @@ -5292,7 +5285,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo @@ -5301,7 +5295,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) end subroutine calc_shelf_visc_triangular subroutine calc_shelf_visc_bilinear (CS, u, v) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is @@ -5317,7 +5311,8 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh G => CS%grid @@ -5364,7 +5359,7 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) end subroutine calc_shelf_visc_bilinear subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(CS%grid%isd:,CS%grid%jsd:) :: ocean_mass integer,intent(in) :: counter integer,intent(in) :: nstep_velocity @@ -5415,7 +5410,7 @@ subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, end subroutine update_OD_ffrac subroutine update_OD_ffrac_uncoupled (CS) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), pointer :: G integer :: i, j, iters, isd, ied, jsd, jed @@ -5586,17 +5581,19 @@ end subroutine bilinear_shape_functions_subgrid subroutine update_velocity_masks (CS) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary - ! !!!!IMPORTANT!!!! relies on thickness mask - assumed that this is called after hmask has been updated (and halo-updated) + ! !!!IMPORTANT!!! relies on thickness mask - assumed that this is called after hmask has been updated & halo-updated - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, k + integer :: isym, i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec integer :: i_off, j_off - type(ocean_grid_type), pointer :: G - real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask, u_face_mask_boundary, v_face_mask_boundary + type(ocean_grid_type), pointer :: G => NULL() + real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask + real, dimension(:,:), pointer :: u_face_mask_boundary, v_face_mask_boundary G => CS%grid isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -5748,11 +5745,12 @@ end subroutine update_velocity_masks subroutine interpolate_H_to_B (CS, h_shelf, hmask, H_node) - type(ice_shelf_CS), pointer :: CS - real, dimension (:,:), intent(in) :: h_shelf, hmask - real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: H_node + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + real, dimension(:,:), intent(in) :: h_shelf, hmask + real, dimension(NILIMB_SYM_,NJLIMB_SYM_), & + intent(inout) :: H_node - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ @@ -5788,7 +5786,7 @@ end subroutine interpolate_H_to_B !> Deallocates all memory associated with this module subroutine ice_shelf_end(CS) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure if (.not.associated(CS)) return @@ -5906,13 +5904,13 @@ end subroutine savearray2 subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real,intent(in) :: time_step integer, intent(inout) :: n type(time_type) :: Time real,optional,intent(in) :: min_time_step_in - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() integer :: is, iec, js, jec, i, j, ki, kj, iters real :: ratio, min_ratio, time_step_remain, local_u_max, & local_v_max, time_step_int, min_time_step,spy,dumtimeprint @@ -6040,7 +6038,7 @@ end subroutine solo_time_step !!! OVS !!! subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate type(time_type), intent(in) :: Time @@ -6055,7 +6053,8 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! t_after_uflux - an array containing the temperature after advection in u-direction ! t_after_vflux - similar ! -! This subroutine takes the velocity (on the Bgrid) and timesteps (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H +! This subroutine takes the velocity (on the Bgrid) and timesteps +! (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H ! ! The flux overflows are included here. That is because they will be used to advect 3D scalars ! into partial cells @@ -6082,7 +6081,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! o--- (3) ---o ! - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: th_after_uflux, th_after_vflux, TH real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec @@ -6191,7 +6190,7 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 real, dimension(:,:), intent(inout) :: h_after_uflux @@ -6218,7 +6217,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary real :: u_face, & ! positive if out @@ -6299,8 +6298,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%t_boundary_values(i-1,j)*CS%h_shelf(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh @@ -6350,8 +6349,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh @@ -6400,7 +6399,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)*CS%thickness_boundary_values(i+1,j) + flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & + CS%thickness_boundary_values(i+1,j) elseif (u_face_mask (i-1,j) .eq. 4.) then flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j)*t_boundary(i-1,j) ! flux_enter (i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i-1,j) @@ -6409,7 +6409,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)*CS%thickness_boundary_values(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)* & + CS%thickness_boundary_values(i+1,j) elseif (u_face_mask (i+1,j) .eq. 4.) then flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) * t_boundary(i+1,j) ! assume no flux bc for temp @@ -6417,14 +6418,14 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif ! if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered - + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 ! elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered - + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 ! endif @@ -6444,7 +6445,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h_after_uflux real, dimension(:,:), intent(inout) :: h_after_vflux @@ -6471,7 +6472,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values real :: v_face, & ! positive if out @@ -6528,7 +6529,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face_mask (i,j-1) .eq. 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * t_boundary(i,j-1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * & + t_boundary(i,j-1)/ dxdyh ! assume no flux bc for temp ! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) / dxdyh @@ -6541,8 +6543,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid @@ -6592,8 +6594,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) @@ -6630,7 +6632,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)*CS%thickness_boundary_values(i,j-1) + flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & + CS%thickness_boundary_values(i,j-1) elseif (v_face_mask(i,j-1) .eq. 4.) then flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1)*t_boundary(i,j-1) ! assume no flux bc for temp @@ -6640,7 +6643,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)*CS%thickness_boundary_values(i,j+1) + flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & + CS%thickness_boundary_values(i,j+1) elseif (v_face_mask(i,j+1) .eq. 4.) then flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1)*t_boundary(i,j+1) ! assume no flux bc for temp @@ -6648,12 +6652,14 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, endif ! if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask (i,j) = 2 ! elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing the + ! front without having to call pass_var - if cell is empty and cell to left is + ! ice-covered then this cell will become partly covered ! hmask (i,j) = 2 ! endif @@ -6702,7 +6708,8 @@ end subroutine ice_shelf_advect_temp_y !! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry !! - does not modify any permanent arrays !! init_boundary_values - -!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and bilinear nodal basis +!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and +!! bilinear nodal basis !! calc_shelf_visc_bilinear - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) !! calc_shelf_visc_triangular - LET'S TAKE THIS OUT !! apply_boundary_values_bilinear - same as CG_action_bilinear, but input is zero except for dirichlet bdry conds @@ -6770,134 +6777,4 @@ end subroutine ice_shelf_advect_temp_y !! Holland, David M., and Adrian Jenkins. Modeling thermodynamic ice-ocean interactions at the base of an ice shelf. !! Journal of Physical Oceanography 29.8 (1999): 1787-1800. - - -! GMM, I am putting all the commented functions below - -! subroutine add_shelf_flux_IOB(CS, state, forces, fluxes) -! ! type(ice_ocean_boundary_type), intent(inout) :: IOB -! type(ice_shelf_CS), intent(in) :: CS -! type(surface), intent(inout) :: state -! type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces -! type(forcing), intent(inout) :: fluxes - -! ! Arguments: -! ! (in) fluxes - A structure of surface fluxes that may be used. -! ! (in) visc - A structure containing vertical viscosities, bottom boundary -! ! layer properies, and related fields. -! ! (in) G - The ocean's grid structure. -! ! (in) CS - This module's control structure. -! !need to use visc variables -! !time step therm v. dynamic? -! real :: Irho0 ! The inverse of the mean density in m3 kg-1. -! real :: frac_area ! The fractional area covered by the ice shelf, nondim. -! real :: taux2, tauy2 ! The squared surface stresses, in Pa. -! real :: asu1, asu2 ! Ocean areas covered by ice shelves at neighboring u- -! real :: asv1, asv2 ! and v-points, in m2. -! integer :: i, j, is, ie, js, je, isd, ied, jsd, jed -! type(ocean_grid_type), pointer :: G - -! G=>CS%grid -! is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec -! isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed - -! Irho0 = 1.0 / CS%Rho0 -! ! Determine ustar and the square magnitude of the velocity in the -! ! bottom boundary layer. Together these give the TKE source and -! ! vertical decay scale. -! if (CS%shelf_mass_is_dynamic) then -! do j=jsd,jed ; do i=isd,ied -! if (G%areaT(i,j) > 0.0) & -! fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) -! enddo ; enddo -! !do I=isd,ied-1 ; do j=isd,jed -! do j=jsd,jed ; do i=isd,ied-1 ! ### changed stride order; i->ied-1? -! forces%frac_shelf_u(I,j) = 0.0 -! if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & -! forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & -! (G%areaT(i,j) + G%areaT(i+1,j))) -! forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) -! enddo ; enddo -! do j=jsd,jed-1 ; do i=isd,ied ! ### change stride order; j->jed-1? -! !do i=isd,ied ; do J=isd,jed-1 -! forces%frac_shelf_v(i,J) = 0.0 -! if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & -! forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & -! (G%areaT(i,j) + G%areaT(i,j+1))) -! forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) -! enddo ; enddo -! call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) -! endif - -! if (CS%debug) then -! if (associated(state%taux_shelf)) then -! call uchksum(state%taux_shelf, "taux_shelf", G%HI, haloshift=0) -! endif -! if (associated(state%tauy_shelf)) then -! call vchksum(state%tauy_shelf, "tauy_shelf", G%HI, haloshift=0) -! endif -! endif - -! if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then -! call pass_vector(state%taux_shelf, state%tauy_shelf, G%domain, TO_ALL, CGRID_NE) -! endif - -! do j=G%jsc,G%jec ; do i=G%isc,G%iec -! frac_area = fluxes%frac_shelf_h(i,j) -! if (frac_area > 0.0) then -! ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. -! taux2 = 0.0 ; tauy2 = 0.0 -! asu1 = forces%frac_shelf_u(i-1,j) * (G%areaT(i-1,j) + G%areaT(i,j)) ! G%dxdy_u(i-1,j) -! asu2 = forces%frac_shelf_u(i,j) * (G%areaT(i,j) + G%areaT(i+1,j)) ! G%dxdy_u(i,j) -! asv1 = forces%frac_shelf_v(i,j-1) * (G%areaT(i,j-1) + G%areaT(i,j)) ! G%dxdy_v(i,j-1) -! asv2 = forces%frac_shelf_v(i,j) * (G%areaT(i,j) + G%areaT(i,j+1)) ! G%dxdy_v(i,j) -! if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & -! taux2 = (asu1 * state%taux_shelf(i-1,j)**2 + & -! asu2 * state%taux_shelf(i,j)**2 ) / (asu1 + asu2) -! if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) & -! tauy2 = (asv1 * state%tauy_shelf(i,j-1)**2 + & -! asv2 * state%tauy_shelf(i,j)**2 ) / (asv1 + asv2) -! fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) - -! if (CS%lprec(i,j) > 0.0) then -! fluxes%lprec(i,j) = fluxes%lprec(i,j) + frac_area*CS%lprec(i,j) -! ! Same for IOB%lprec -! else -! fluxes%evap(i,j) = fluxes%evap(i,j) + frac_area*CS%lprec(i,j) -! ! Same for -1*IOB%q_flux -! endif -! fluxes%sens(i,j) = fluxes%sens(i,j) - frac_area*CS%t_flux(i,j) -! ! Same for -1*IOB%t_flux -! ! fluxes%salt_flux(i,j) = fluxes%salt_flux(i,j) + frac_area * CS%salt_flux(i,j) -! ! ! Same for IOB%salt_flux. -! fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + & -! frac_area * CS%g_Earth * CS%mass_shelf(i,j) -! ! Same for IOB%p -! if (associated(fluxes%p_surf_full)) fluxes%p_surf_full(i,j) = & -! fluxes%p_surf_full(i,j) + frac_area * CS%g_Earth * CS%mass_shelf(i,j) -! endif -! enddo ; enddo - -! if (CS%debug) then -! call hchksum(fluxes%ustar_shelf, "ustar_shelf", G%HI, haloshift=0) -! endif - -! ! If the shelf mass is changing, the forces%rigidity_ice_[uv] needs to be -! ! updated here. - -! if (CS%shelf_mass_is_dynamic) then -! do j=G%jsc,G%jec ; do i=G%isc-1,G%iec -! forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) -! enddo ; enddo - -! do j=G%jsc-1,G%jec ; do i=G%isc,G%iec -! forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) -! enddo ; enddo -! endif -! end subroutine add_shelf_flux_IOB - end module MOM_ice_shelf diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 new file mode 100644 index 0000000000..342198b4ca --- /dev/null +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -0,0 +1,206 @@ +!> Routines incorporating the effects of marine ice (sea-ice and icebergs) into +!! the ocean model dynamics and thermodynamics. +module MOM_marine_ice + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_constants, only : hlf +use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_time_manager, only : time_type +use MOM_variables, only : surface + +implicit none ; private + +#include + +public iceberg_forces, iceberg_fluxes, marine_ice_init + +!> Control structure for MOM_marine_ice +type, public :: marine_ice_CS ; private + real :: kv_iceberg !< The viscosity of the icebergs in m2/s (for ice rigidity) + real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy + !! so that fluxes below are set to zero. (0.5 is a + !! good value to use.) Not applied for negative values. + real :: latent_heat_fusion !< Latent heat of fusion + real :: density_iceberg !< A typical density of icebergs in kg/m3 (for ice rigidity) + + type(time_type), pointer :: Time !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. +end type marine_ice_CS + +contains + +!> add_berg_flux_to_shelf adds rigidity and ice-area coverage due to icebergs +!! to the forces type fields, and adds ice-areal coverage and modifies various +!! thermodynamic fluxes due to the presence of icebergs. +subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & + time_step, CS) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. + real, intent(in) :: time_step !< The coupling time step, in s. + type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice + + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + !This routine adds iceberg data to the ice shelf data (if ice shelf is used) + !which can then be used to change the top of ocean boundary condition used in + !the ocean model. This routine is taken from the add_shelf_flux subroutine + !within the ice shelf model. + + if (.not.associated(CS)) return + + if (.not.(associated(forces%area_berg) .and. associated(forces%mass_berg) ) ) return + + if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & + associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) ) return + + ! This section sets or augments the values of fields in forces. + if (.not. use_ice_shelf) then + forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 + endif + + call pass_var(forces%area_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.false.) + call pass_var(forces%mass_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.true.) + kv_rho_ice = CS%kv_iceberg / CS%density_iceberg + do j=js,je ; do I=is-1,ie + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & + forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & + (((forces%area_berg(i,j)*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & + (G%areaT(i,j) + G%areaT(i+1,j)) ) + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & + min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) + enddo ; enddo + do J=js-1,je ; do i=is,ie + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & + forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & + (((forces%area_berg(i,j)*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & + (G%areaT(i,j) + G%areaT(i,j+1)) ) + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & + min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) + enddo ; enddo + !### This halo update may be unnecessary. Test it. -RWH + call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) + +end subroutine iceberg_forces + +!> iceberg_fluxes adds ice-area-coverage and modifies various +!! thermodynamic fluxes due to the presence of icebergs. +subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & + time_step, CS) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, + !! tracer and mass exchange forcing fields + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. + real, intent(in) :: time_step !< The coupling time step, in s. + type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice + + real :: fraz ! refreezing rate in kg m-2 s-1 + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + !This routine adds iceberg data to the ice shelf data (if ice shelf is used) + !which can then be used to change the top of ocean boundary condition used in + !the ocean model. This routine is taken from the add_shelf_flux subroutine + !within the ice shelf model. + + if (.not.associated(CS)) return + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return + if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return + + + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return + if (.not. use_ice_shelf) then + fluxes%frac_shelf_h(:,:) = 0. + fluxes%ustar_shelf(:,:) = 0. + endif + do j=jsd,jed ; do i=isd,ied ; if (G%areaT(i,j) > 0.0) then + fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) + fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) + endif ; enddo ; enddo + + !Zero'ing out other fluxes under the tabular icebergs + if (CS%berg_area_threshold >= 0.) then + I_dt_LHF = 1.0 / (time_step * CS%latent_heat_fusion) + do j=jsd,jed ; do i=isd,ied + if (fluxes%frac_shelf_h(i,j) > CS%berg_area_threshold) then + ! Only applying for ice shelf covering most of cell. + + if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 + if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 + if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 + if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 + + ! Add frazil formation diagnosed by the ocean model (J m-2) in the + ! form of surface layer evaporation (kg m-2 s-1). Update lprec in the + ! control structure for diagnostic purposes. + + if (associated(sfc_state%frazil)) then + fraz = sfc_state%frazil(i,j) * I_dt_LHF + if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz + !CS%lprec(i,j)=CS%lprec(i,j) - fraz + sfc_state%frazil(i,j) = 0.0 + endif + + !Alon: Should these be set to zero too? + if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 + if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 + if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 + endif + enddo ; enddo + endif + +end subroutine iceberg_fluxes + +!> Initialize control structure for MOM_marine_ice +subroutine marine_ice_init(Time, G, param_file, diag, CS) + type(time_type), target, intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Runtime parameter handles + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "MOM_marine_ice" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "marine_ice_init called with an "// & + "associated control structure.") + return + else ; allocate(CS) ; endif + + ! Write all relevant parameters to the model log. + call log_version(mdl, version) + + call get_param(param_file, mdl, "KV_ICEBERG", CS%kv_iceberg, & + "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) + call get_param(param_file, mdl, "DENSITY_ICEBERGS", CS%density_iceberg, & + "A typical density of icebergs.", units="kg m-3", default=917.0) + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & + "The latent heat of fusion.", units="J/kg", default=hlf) + call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", CS%berg_area_threshold, & + "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& + "below berg are set to zero. Not applied for negative \n"//& + "values.", units="non-dim", default=-1.0) + +end subroutine marine_ice_init + +end module MOM_marine_ice diff --git a/src/ice_shelf/shelf_triangular_FEstuff.F90 b/src/ice_shelf/shelf_triangular_FEstuff.F90 index 72c0043ebf..6829774386 100644 --- a/src/ice_shelf/shelf_triangular_FEstuff.F90 +++ b/src/ice_shelf/shelf_triangular_FEstuff.F90 @@ -67,8 +67,8 @@ module shelf_triangular_FEstuff v_boundary_values => NULL(), & - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal law exponent - ! and/or whether flow is "hybridized" a la Goldberg 2011 + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal + ! law exponent and/or whether flow is "hybridized" a la Goldberg 2011 taub_beta_eff_lower_tri => NULL(), & taub_beta_eff_upper_tri => NULL(), & @@ -124,7 +124,8 @@ module shelf_triangular_FEstuff ! ~ once a day (maybe longer) because it will depend on ocean values ! that are averaged over this time interval, and the solve will begin ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; the counter will have to be stored + integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; + ! the counter will have to be stored integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) @@ -518,7 +519,8 @@ end subroutine matrix_diagonal_triangle !~ hmask !~ type(ocean_grid_type), pointer :: G - !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + !~ integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js !~ real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh !~ G => CS%grid @@ -558,7 +560,8 @@ end subroutine matrix_diagonal_triangle !~ nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) !~ umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) !~ vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + !~ beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) !~ ux = (u(i,j)-u(i-1,j)) / dxh !~ vx = (v(i,j)-v(i-1,j)) / dxh @@ -568,7 +571,8 @@ end subroutine matrix_diagonal_triangle !~ nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) !~ umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) !~ vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + !~ beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) !~ endif !~ enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 8bb7a290ee..b150b8c4ad 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -265,7 +265,8 @@ subroutine apply_topography_edits_from_file(D, G, param_file) j = jg(n) - G%jsd_global + 2 if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then if (new_depth(n)/=0.) then - write(*,'(a,3i5,f8.2,a,f8.2,2i4)') 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j),'->',abs(new_depth(n)),i,j + write(*,'(a,3i5,f8.2,a,f8.2,2i4)') & + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j),'->',abs(new_depth(n)),i,j D(i,j) = abs(new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& @@ -445,13 +446,12 @@ end subroutine limit_topography ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets up the Coriolis parameter for a sphere subroutine set_rotation_planetary(f, G, param_file) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: f - Coriolis parameter (vertical component) in s^-1 -! (in) G - grid type -! (in) param_file - parameter file type + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. @@ -474,13 +474,12 @@ end subroutine set_rotation_planetary ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets up the Coriolis parameter for a beta-plane or f-plane subroutine set_rotation_beta_plane(f, G, param_file) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: f - Coriolis parameter (vertical component) in s^-1 -! (in) G - grid type -! (in) param_file - parameter file type + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J @@ -546,10 +545,13 @@ subroutine initialize_grid_rotation_angle(G, PF) end subroutine initialize_grid_rotation_angle ! ----------------------------------------------------------------------------- +!> This subroutine sets the open face lengths at selected points to restrict +!! passages to their observed widths based on a named set of sizes. subroutine reset_face_lengths_named(G, param_file, name) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - character(len=*), intent(in) :: name + character(len=*), intent(in) :: name !< The name for the set of face lengths. Only "global_1deg" + !! is currently implemented. ! This subroutine sets the open face lengths at selected points to restrict ! passages to their observed widths. @@ -671,6 +673,8 @@ end subroutine reset_face_lengths_named ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets the open face lengths at selected points to restrict +!! passages to their observed widths from a arrays read from a file. subroutine reset_face_lengths_file(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -738,6 +742,8 @@ end subroutine reset_face_lengths_file ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets the open face lengths at selected points to restrict +!! passages to their observed widths from a list read from a file. subroutine reset_face_lengths_list(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -915,7 +921,8 @@ subroutine reset_face_lengths_list(G, param_file) write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") so grid metric is unmodified." else - write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& + write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & + "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",G%dy_Cu(I,j),"m" endif endif @@ -943,7 +950,8 @@ subroutine reset_face_lengths_list(G, param_file) write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") so grid metric is unmodified." else - write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& + write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & + "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",G%dx_Cv(I,j),"m" endif endif @@ -965,11 +973,12 @@ end subroutine reset_face_lengths_list ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine reads and counts the non-blank lines in the face length list file, after removing comments. subroutine read_face_length_list(iounit, filename, num_lines, lines) - integer, intent(in) :: iounit - character(len=*), intent(in) :: filename - integer, intent(out) :: num_lines - character(len=120), dimension(:), pointer :: lines + integer, intent(in) :: iounit !< An open I/O unit number for the file + character(len=*), intent(in) :: filename !< The name of the face-length file to read + integer, intent(out) :: num_lines !< The number of non-blank lines in the file + character(len=120), dimension(:), pointer :: lines !< The non-blank lines, after removing comments ! This subroutine reads and counts the non-blank lines in the face length ! list file, after removing comments. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4ef3af5949..b26e13b61e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -268,8 +268,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) - case ("thickness_file"); call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) + case ("file") + call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) + case ("thickness_file") + call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -469,7 +471,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.) - call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, dt=dt, initial=.true.) + call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, & + dt=dt, initial=.true.) endif endif ! This is the end of the block of code that might have initialized fields @@ -613,19 +616,11 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! Arguments: h - The thickness that is being initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) file_has_thickness - If true, this file contains thicknesses; -! otherwise it contains interface heights. - ! This subroutine reads the layer thicknesses from file. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) integer :: inconsistent = 0 logical :: correct_thickness - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz @@ -709,8 +704,8 @@ end subroutine initialize_thickness_from_file subroutine adjustEtaToFitBathymetry(G, GV, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) @@ -789,19 +784,13 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! Arguments: h - The thickness that is being initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - ! This subroutine initializes the layer thicknesses to be uniform. character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -864,7 +853,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var integer :: i, j, k, is, ie, js, je, nz @@ -937,7 +926,7 @@ end subroutine initialize_thickness_search subroutine convert_thickness(h, G, GV, tv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Input eometric layer thicknesses (in H units), !! being converted to layer pressure !! thicknesses (also in H units). @@ -1016,7 +1005,7 @@ end subroutine convert_thickness subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -1119,8 +1108,8 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) ! Local variables character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface (Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b, T_t, T_b ! Top and bottom edge values for reconstructions - ! of salinity and temperature within each layer. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor, min_thickness integer :: i, j, k @@ -1264,8 +1253,10 @@ end subroutine cut_off_column_top ! ----------------------------------------------------------------------------- subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1308,8 +1299,10 @@ end subroutine initialize_velocity_from_file ! ----------------------------------------------------------------------------- subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1346,8 +1339,10 @@ end subroutine initialize_velocity_zero ! ----------------------------------------------------------------------------- subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1389,8 +1384,10 @@ end subroutine initialize_velocity_uniform ! ----------------------------------------------------------------------------- subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1451,8 +1448,8 @@ end subroutine initialize_velocity_circular ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1516,7 +1513,8 @@ end subroutine initialize_temp_salt_from_file ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1571,11 +1569,8 @@ end subroutine initialize_temp_salt_from_profile subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: T !< The potential temperature that is being - !! initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the equatio of state. @@ -1669,14 +1664,15 @@ end subroutine initialize_temp_salt_fit ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S - type(param_file_type), intent(in) :: param_file !< A structure to parse for - !! run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, - !! this call will only read - !! parameters without - !! changing h. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, + !! this call will only read + !! parameters without + !! changing h. ! This subroutine initializes linear profiles for T and S according to ! reference surface layer salinity and temperature and a specified range. @@ -2266,7 +2262,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) ! In case data is shallower than model + h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo deallocate( tmp_mask_in ) @@ -2317,8 +2314,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif deallocate( dz_interface ) endif - call ALE_remap_scalar( remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, old_remap=remap_old_alg ) - call ALE_remap_scalar( remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, old_remap=remap_old_alg ) + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, & + old_remap=remap_old_alg ) + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & + old_remap=remap_old_alg ) deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) @@ -2452,7 +2451,8 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), rho(k), tv%eqn_of_state) + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & + rho(k), tv%eqn_of_state) P_tot = P_tot + GV%g_Earth * rho(k) * h(k) enddo diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index c1ba6793b8..7cdc440f62 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -227,8 +227,8 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, real, intent(in) :: land_fill real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs -logical, intent(in), optional :: debug -integer, intent(in), optional :: i_debug, j_debug +logical, optional, intent(in) :: debug +integer, optional, intent(in) :: i_debug, j_debug real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr real, dimension(size(tr_in,3)) :: tr_1d @@ -397,7 +397,7 @@ function bisect_fast(a, x, lo, hi) result(bi_r) real, dimension(:,:), intent(in) :: a real, dimension(:), intent(in) :: x -integer, dimension(size(a,1)), intent(in), optional :: lo,hi +integer, dimension(size(a,1)), optional, intent(in) :: lo,hi integer, dimension(size(a,1),size(x,1)) :: bi_r integer :: mid,num_x,num_a,i @@ -494,7 +494,7 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos integer, intent(in) :: k_start real, intent(in) :: land_fill real, dimension(:,:,:), intent(in) :: h -type(eos_type), pointer, intent(in) :: eos +type(eos_type), pointer :: eos real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS @@ -689,7 +689,8 @@ function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val real, dimension(:), intent(in) :: e integer, intent(in) :: k -real :: slope,amx,bmx,amn,bmn,cmn,dmn +real :: slope +real :: amx,bmx,amn,bmn,cmn,dmn real :: d1, d2 @@ -719,8 +720,6 @@ function find_limited_slope(val, e, k) result(slope) end function find_limited_slope - - function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) ! (in) rho : potential density in z-space (kg m-3) ! (in) zin : levels (m) @@ -731,15 +730,20 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) ! (in) nkbl : number of buffer layer pieces ! (in) hml : mixed layer depth -real, dimension(:,:,:), intent(in) :: rho -real, dimension(size(rho,3)), intent(in) :: zin +real, dimension(:,:,:), & + intent(in) :: rho +real, dimension(size(rho,3)), & + intent(in) :: zin real, dimension(:), intent(in) :: Rb -real, dimension(size(rho,1),size(rho,2)), intent(in) :: depth -real, dimension(size(rho,1),size(rho,2)), optional, intent(in) ::nlevs -logical, optional, intent(in) :: debug +real, dimension(size(rho,1),size(rho,2)), & + intent(in) :: depth +real, dimension(size(rho,1),size(rho,2)), & + optional, intent(in) ::nlevs +logical, optional, intent(in) :: debug +integer, optional, intent(in) :: nkml +integer, optional, intent(in) :: nkbl +real, optional, intent(in) :: hml real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi -integer, intent(in), optional :: nkml, nkbl -real, intent(in), optional :: hml real, dimension(size(rho,1),size(rho,3)) :: rho_ real, dimension(size(rho,1)) :: depth_ @@ -758,8 +762,7 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) nlay=size(Rb)-1 -zi=0.0 - +zi(:,:,:) = 0.0 if (PRESENT(debug)) debug_=debug @@ -949,8 +952,6 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) mp = fill_boundaries(zi,cyclic_x,tripolar_n) end do - - return end subroutine smooth_heights @@ -1010,6 +1011,4 @@ function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) end function fill_boundaries_real - - end module midas_vertmap diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d322e115c9..f60e4ce013 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -259,13 +259,17 @@ subroutine init_oda(Time, G, GV, CS) call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.) do n=1,CS%ensemble_size write(fldnam,'(a,i2.2)') 'temp_prior_',n - CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean potential temperature','degC') + CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') write(fldnam,'(a,i2.2)') 'salt_prior_',n - CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean salinity','psu') + CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') write(fldnam,'(a,i2.2)') 'temp_posterior_',n - CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean potential temperature','degC') + CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') write(fldnam,'(a,i2.2)') 'salt_posterior_',n - CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean salinity','psu') + CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') enddo call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) @@ -366,8 +370,10 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) call mpp_redistribute(CS%domains(m)%mpp_domain, S,& CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) - if (CS%Ocean_prior%id_t(m)>0) used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) - if (CS%Ocean_prior%id_s(m)>0) used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_t(m)>0) & + used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_s(m)>0) & + used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) enddo deallocate(T,S) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9ac56b03c6..10882aed75 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1319,11 +1319,11 @@ end subroutine MEKE_end !! !! \subsection section_MEKE_references References !! -!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a mesoscale energy -!! budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . +!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a +!! mesoscale energy budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . !! -!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics and Arnold -!! first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . +!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics +!! and Arnold first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . end module MOM_MEKE diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 5a7dbf7208..c4e771375c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -237,7 +237,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !! specify the spatially variable viscosities type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous !! call to hor_visc_init. - type(ocean_OBC_type), pointer, optional :: OBC !< Pointer to an open boundary condition type + type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type ! Arguments: ! (in) u - zonal velocity (m/s) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fbc78f3bdd..61555090ab 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1053,8 +1053,8 @@ end subroutine VarMix_init !! r(\Delta,L_d) = \frac{1}{1+(\alpha R)^p} !! \f] !! -!! The resolution function can be applied independently to thickness diffusion (module mom_thickness_diffuse), tracer diffusion (mom_tracer_hordiff) -!! lateral viscosity (mom_hor_visc). +!! The resolution function can be applied independently to thickness diffusion (module mom_thickness_diffuse), +!! tracer diffusion (mom_tracer_hordiff) lateral viscosity (mom_hor_visc). !! !! Robert Hallberg, 2013: Using a resolution function to regulate parameterizations of oceanic mesoscale eddy effects. !! Ocean Modelling, 71, pp 92-103. http://dx.doi.org/10.1016/j.ocemod.2013.08.007 @@ -1075,8 +1075,8 @@ end subroutine VarMix_init !! !! \section section_Vicbeck Visbeck diffusivity !! -!! This module also calculates factors used in setting the thickness diffusivity similar to a Visbeck et al., 1997, scheme. -!! The factors are combined in mom_thickness_diffuse::thickness_diffuse() but calculated in this module. +!! This module also calculates factors used in setting the thickness diffusivity similar to a Visbeck et al., 1997, +!! scheme. The factors are combined in mom_thickness_diffuse::thickness_diffuse() but calculated in this module. !! !! \f[ !! \kappa_h = \alpha_s L_s^2 S N @@ -1098,9 +1098,9 @@ end subroutine VarMix_init !! !! \section section_vertical_structure_khth Vertical structure function for KhTh !! -!! The thickness diffusivity can be prescribed a vertical distribution with the shape of the equivalent barotropic velocity mode. -!! The structure function is stored in the control structure for thie module (varmix_cs) but is calculated use subroutines in -!! mom_wave_speed. +!! The thickness diffusivity can be prescribed a vertical distribution with the shape of the equivalent barotropic +!! velocity mode. The structure function is stored in the control structure for thie module (varmix_cs) but is +!! calculated using subroutines in mom_wave_speed. !! !! | Symbol | Module parameter | !! | ------ | --------------- | diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 840a0c3373..ba76c208cc 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -93,7 +93,8 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) - real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by PBL scheme (H units) + real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the + !! PBL scheme (H units) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure @@ -119,7 +120,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) - real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by PBL scheme, in m (not H) + real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the + !! PBL scheme, in m (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables @@ -215,7 +217,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo ! k-loop do i = is-1, ie+1 MLD_fast(i,j) = CS%MLE_MLD_stretch * MLD_fast(i,j) - if ((MLD_fast(i,j)==0.) .and. (deltaRhoAtK(i) + \alpha_{M} \kappa_{M} \right) r(\Delta x,L_d) !! \f] !! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the square root of Brunt-Vaisala frequency, -!! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and \f$ r(\Delta x,L_d) \f$ is -!! a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, to deformation radius, \f$L_d\f$). -!! The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module (enabled with -!! USE_VARIABLE_MIXING=True and the term \f$\f$ is the vertical average slope times Brunt-Vaisala frequency -!! prescribed by Visbeck et al., 1996. +!! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and +!! \f$ r(\Delta x,L_d) \f$ is a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, +!! to deformation radius, \f$L_d\f$). The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module +!! (enabled with USE_VARIABLE_MIXING=True and the term \f$\f$ is the vertical average slope +!! times the Brunt-Vaisala frequency prescribed by Visbeck et al., 1996. !! !! The result of the above expression is subsequently bounded by minimum and maximum values, including an upper !! diffusivity consistent with numerical stability (\f$ \kappa_{cfl} \f$ is calculated internally). !! \f[ -!! \kappa_h \leftarrow \min{\left( \kappa_{max}, \kappa_{cfl}, \max{\left( \kappa_{min}, \kappa_h \right)} \right)} f(c_g,z) +!! \kappa_h \leftarrow \min{\left( \kappa_{max}, \kappa_{cfl}, \max{\left( \kappa_{min}, \kappa_h \right)} \right)} +!! f(c_g,z) !! \f] !! !! where \f$f(c_g,z)\f$ is a vertical structure function. !! \f$f(c_g,z)\f$ is calculated in module mom_lateral_mixing_coeffs. -!! If KHTH_USE_EBT_STRUCT=True then \f$f(c_g,z)\f$ is set to look like the equivalent barotropic modal velocity structure. -!! Otherwise \f$f(c_g,z)=1\f$ and the diffusivity is independent of depth. +!! If KHTH_USE_EBT_STRUCT=True then \f$f(c_g,z)\f$ is set to look like the equivalent barotropic +!! modal velocity structure. Otherwise \f$f(c_g,z)=1\f$ and the diffusivity is independent of depth. !! !! In order to calculate meaningful slopes in vanished layers, temporary copies of the thermodynamic variables !! are passed through a vertical smoother, function vert_fill_ts(): diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 905490d88e..308b7ca9b6 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -113,12 +113,14 @@ module MOM_ALE_sponge ! heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - integer, intent(in) :: nz_data !< The total number of sponge input layers (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). - real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. (in). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + integer, intent(in) :: nz_data !< The total number of sponge input layers (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). + real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. ! This include declares and sets the variable "version". @@ -298,10 +300,12 @@ end subroutine initialize_ALE_sponge_fixed ! heights. subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse + !! for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). @@ -472,10 +476,12 @@ end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable ! whose address is given by f_ptr. subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZI_(G),SZJ_(G),CS%nz_data), intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & + intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -507,12 +513,13 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable ! whose address is given by filename and fieldname. subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, CS) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: fieldname - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: fieldname + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data @@ -602,7 +609,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, if (hsrc(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! In case data is deeper than model + ! In case data is deeper than model + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -620,12 +628,14 @@ end subroutine set_up_ALE_sponge_field_varying !> This subroutine stores the reference profile at uand v points for the variable ! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJB_(G),CS%nz_data), intent(in) :: v_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), & + intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJB_(G),CS%nz_data), & + intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -751,13 +761,15 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v end subroutine set_up_ALE_sponge_vel_field_varying -!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers for every column where there is damping. +!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers +!! for every column where there is damping. subroutine apply_ALE_sponge(h, dt, G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness, in m (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). - type(ALE_sponge_CS), pointer :: CS !0) then do i=is,ie pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) ! This might change answers at roundoff. + !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This might change answers at roundoff. enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) do i=is,ie @@ -750,7 +753,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) ! This might change answers at roundoff. + !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 24ebb3ebd1..17f363850f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -251,7 +251,8 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, GV, CS, WAVES) +subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) @@ -270,7 +271,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G real, intent(in) :: dt !< time increment (seconds) type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), pointer, optional :: Waves !< Surface gravity waves + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea, & ! amount of fluid entrained from the layer above within @@ -1680,15 +1681,19 @@ end subroutine diagnose_diabatic_diff_tendency !! in which case we distribute the flux into k > 1 layers. subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness after boundary flux application (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to boundary flux application - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) - real, intent(in) :: dt !< time step (sec) - type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< thickness after boundary flux application (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: temp_old !< temperature prior to boundary flux application + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d @@ -1821,13 +1826,14 @@ end subroutine diagnose_frazil_tendency !! of the diabatic processes to be used. subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & tracer_flow_CSp, diag_to_Z_CSp) - type(time_type), intent(in) :: Time !< current model time - type(ocean_grid_type), intent(in) :: G !< model grid structure - type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values - type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output - type(diabatic_CS), pointer :: CS !< module control structure - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< points to control structure of tracer flow control module - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure + type(time_type), intent(in) :: Time !< current model time + type(ocean_grid_type), intent(in) :: G !< model grid structure + type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values + type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output + type(diabatic_CS), pointer :: CS !< module control structure + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the + !! tracer flow control module + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure ! This "include" declares and sets the variable "version". #include "version_variable.h" @@ -1864,7 +1870,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, !! to enable diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< pointers to terms in continuity equations type(diabatic_CS), pointer :: CS !< module control structure - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of tracer flow control module + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the + !! tracer flow control module type(sponge_CS), pointer :: sponge_CSp !< pointer to the sponge module control structure type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control structure @@ -2202,54 +2209,54 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%diabatic_diff_tendency_diag = .true. endif - CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & - 'diabatic_heat_tendency', diag%axesTL, Time, & - 'Diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff', & - cmor_standard_name= & - 'tendency_of_sea_water_potential_temperature_expressed_as_heat_content_due_to_parameterized_dianeutral_mixing',& - cmor_long_name = & - 'Tendency of sea water potential temperature expressed as heat content due to parameterized dianeutral mixing',& + CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & + 'diabatic_heat_tendency', diag%axesTL, Time, & + 'Diabatic diffusion heat tendency', & + 'W m-2',cmor_field_name='opottempdiff', & + cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'// & + 'due_to_parameterized_dianeutral_mixing', & + cmor_long_name='Tendency of sea water potential temperature expressed as heat content '// & + 'due to parameterized dianeutral mixing',& v_extensive=.true.) if (CS%id_diabatic_diff_heat_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif - CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & - 'diabatic_salt_tendency', diag%axesTL, Time, & - 'Diabatic diffusion of salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff', & - cmor_standard_name= & - 'tendency_of_sea_water_salinity_expressed_as_salt_content_due_to_parameterized_dianeutral_mixing', & - cmor_long_name = & - 'Tendency of sea water salinity expressed as salt content due to parameterized dianeutral mixing', & + CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & + 'diabatic_salt_tendency', diag%axesTL, Time, & + 'Diabatic diffusion of salt tendency', & + 'kg m-2 s-1',cmor_field_name='osaltdiff', & + cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & + 'due_to_parameterized_dianeutral_mixing', & + cmor_long_name='Tendency of sea water salinity expressed as salt content '// & + 'due to parameterized dianeutral mixing', & v_extensive=.true.) if (CS%id_diabatic_diff_salt_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif ! This diagnostic should equal to roundoff if all is working well. - CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & - 'diabatic_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff_2d', & - cmor_standard_name= & - 'tendency_of_sea_water_potential_temperature_expressed_as_heat_content_due_to_parameterized_dianeutral_mixing_depth_integrated',& - cmor_long_name = & - 'Tendency of sea water potential temperature expressed as heat content due to parameterized dianeutral mixing depth integrated') + CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & + 'diabatic_heat_tendency_2d', diag%axesT1, Time, & + 'Depth integrated diabatic diffusion heat tendency', & + 'W m-2',cmor_field_name='opottempdiff_2d', & + cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'//& + 'due_to_parameterized_dianeutral_mixing_depth_integrated', & + cmor_long_name='Tendency of sea water potential temperature expressed as heat content '//& + 'due to parameterized dianeutral mixing depth integrated') if (CS%id_diabatic_diff_heat_tend_2d > 0) then CS%diabatic_diff_tendency_diag = .true. endif ! This diagnostic should equal to roundoff if all is working well. - CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & - 'diabatic_salt_tendency_2d', diag%axesT1, Time, & - 'Depth integrated diabatic diffusion salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & - cmor_standard_name= & - 'tendency_of_sea_water_salinity_expressed_as_salt_content_due_to_parameterized_dianeutral_mixing_depth_integrated',& - cmor_long_name = & - 'Tendency of sea water salinity expressed as salt content due to parameterized dianeutral mixing depth integrated') + CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & + 'diabatic_salt_tendency_2d', diag%axesT1, Time, & + 'Depth integrated diabatic diffusion salt tendency', & + 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & + cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & + 'due_to_parameterized_dianeutral_mixing_depth_integrated', & + cmor_long_name='Tendency of sea water salinity expressed as salt content '// & + 'due to parameterized dianeutral mixing depth integrated') if (CS%id_diabatic_diff_salt_tend_2d > 0) then CS%diabatic_diff_tendency_diag = .true. endif @@ -2368,7 +2375,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp, CS%tidal_mixing_CSp) + call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & + CS%int_tide_CSp, CS%tidal_mixing_CSp) ! set up the clocks for this module diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 7054a90ca4..afdebe4ae5 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -282,8 +282,10 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do_print = .false. ; if (present(may_print) .and. present(CS)) do_print = may_print - dPEa_dKd(:) = 0.0 ; dPEa_dKd_est(:) = 0.0 ; dPEa_dKd_err(:) = 0.0 ; dPEa_dKd_err_norm(:) = 0.0 ; dPEa_dKd_trunc(:) = 0.0 - dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 ; dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 + dPEa_dKd(:) = 0.0 ; dPEa_dKd_est(:) = 0.0 ; dPEa_dKd_err(:) = 0.0 + dPEa_dKd_err_norm(:) = 0.0 ; dPEa_dKd_trunc(:) = 0.0 + dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 + dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 htot = 0.0 ; pres(1) = 0.0 ; Z_int(1) = 0.0 do k=1,nz diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d7ea7007c6..541caccf97 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -266,8 +266,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !! diagnostics will be written. The default !! is .true. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dT_expected, dS_expected - type(wave_parameters_CS), pointer, optional :: Waves ! Given an entrainment from below for layer kb, determine a consistent +!! entrainment from above, such that dSkb * ea_kb = dSkbp1 * F_kb. The input +!! value of ea_kb is both the maximum value that can be obtained and the first +!! guess of the iterations. Ideally ea_kb should be an under-estimate subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & G, GV, CS, ea_kb, tol_in) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -1525,10 +1528,6 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & real, dimension(SZI_(G)), intent(inout) :: ea_kb real, optional, intent(in) :: tol_in - ! Given an entrainment from below for layer kb, determine a consistent - ! entrainment from above, such that dSkb * ea_kb = dSkbp1 * F_kb. The input - ! value of ea_kb is both the maximum value that can be obtained and the first - ! guess of the iterations. Also, make sure that ea_kb is an under-estimate real :: max_ea, min_ea real :: err, err_min, err_max real :: derr_dea @@ -1630,6 +1629,9 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & end subroutine F_kb_to_ea_kb +!> This subroutine determines the entrainment from above by the top interior +!! layer (labeled kb elsewhere) given an entrainment by the layer below it, +!! constrained to be within the provided bounds. subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & min_eakb, max_eakb, kmb, is, ie, do_i, G, GV, CS, Ent, & error, err_min_eakb0, err_max_eakb0, F_kb, dFdfm_kb) @@ -1667,19 +1669,19 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost !! interior layer, in H. The input value !! is the first guess. - real, dimension(SZI_(G)), intent(out), optional :: error !< The error (locally defined in this + real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this !! routine) associated with the returned !! solution. - real, dimension(SZI_(G)), intent(in), optional :: err_min_eakb0, err_max_eakb0 !< The errors + real, dimension(SZI_(G)), optional, intent(in) :: err_min_eakb0, err_max_eakb0 !< The errors !! (locally defined) associated with !! min_eakb and max_eakb when ea_kbp1 !! = 0, returned from a previous call !! to this routine. - real, dimension(SZI_(G)), intent(out), optional :: F_kb !< The entrainment from below by the + real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the !! uppermost interior layer !! corresponding to the returned !! value of Ent, in H. - real, dimension(SZI_(G)), intent(out), optional :: dFdfm_kb !< The partial derivative of F_kb with + real, dimension(SZI_(G)), optional, intent(out) :: dFdfm_kb !< The partial derivative of F_kb with !! ea_kbp1, nondim. ! Arguments: h_bl - Layer thickness, with the top interior layer at k-index @@ -1868,71 +1870,49 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & end subroutine determine_Ea_kb +!> Maximize F = ent*ds_kb*I_dSkbp1 in the range min_ent < ent < max_ent. subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & kmb, is, ie, G, GV, CS, maxF, ent_maxF, do_i_in, & F_lim_maxent, F_thresh) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h_bl !< Layer thickness, in m or kg m-2 - !! (abbreviated as H below). + intent(in) :: h_bl !< Layer thickness, in m or kg m-2 + !! (abbreviated as H below). real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: Sref !< Reference potential density (in kg m-3?). + intent(in) :: Sref !< Reference potential density (in kg m-3?). real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: Ent_bl !< The average entrainment upward and - !! downward across each interface around - !! the buffer layers, in H. - real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in - !! reference potential density across the - !! base of the uppermost interior layer, - !! in units of m3 kg-1. - real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, - !! in H. - real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, - !! in H. - integer, intent(in) :: kmb - integer, intent(in) :: is, ie !< The range of i-indices to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F - !! = ent*ds_kb*I_dSkbp1 found in the range - !! min_ent < ent < max_ent, in H. - real, dimension(SZI_(G)), intent(out), & - optional :: ent_maxF !< The value of ent at that maximum, in H. - logical, dimension(SZI_(G)), intent(in), & - optional :: do_i_in !< A logical array indicating which columns - !! to work on. - real, dimension(SZI_(G)), intent(out), & - optional :: F_lim_maxent !< If present, do not apply the limit in - !! finding the maximum value, but return the - !! limited value at ent=max_ent_in in this - !! array, in H. - real, dimension(SZI_(G)), intent(in), & - optional :: F_thresh !< If F_thresh is present, return the first - !! value found that has F > F_thresh, or - !! the maximum. - -! Arguments: h_bl - Layer thickness, in m or kg m-2 (abbreviated as H below). -! (in) Sref - Reference potential density (in kg m-3?) -! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H. -! (in) I_dSkbp1 - The inverse of the difference in reference potential -! density across the base of the uppermost interior layer, -! in units of m3 kg-1. -! (in) min_ent_in - The minimum value of ent to search, in H. -! (in) max_ent_in - The maximum value of ent to search, in H. -! (in) is, ie - The range of i-indices to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - This module's control structure. -! (out) maxF - The maximum value of F = ent*ds_kb*I_dSkbp1 found in the -! range min_ent < ent < max_ent, in H. -! (out,opt) ent_maxF - The value of ent at that maximum, in H. -! (in, opt) do_i_in - A logical array indicating which columns to work on. -! (out,opt) F_lim_maxent - If present, do not apply the limit in finding the -! maximum value, but return the limited value at -! ent=max_ent_in in this array, in H. -! (in, opt) F_thresh - If F_thresh is present, return the first value found -! that has F > F_thresh, or the maximum. + intent(in) :: Ent_bl !< The average entrainment upward and + !! downward across each interface around + !! the buffer layers, in H. + real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in + !! reference potential density across the + !! base of the uppermost interior layer, + !! in units of m3 kg-1. + real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, + !! in H. + real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, + !! in H. + integer, intent(in) :: kmb + integer, intent(in) :: is, ie !< The range of i-indices to work on. + type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F + !! = ent*ds_kb*I_dSkbp1 found in the range + !! min_ent < ent < max_ent, in H. + real, dimension(SZI_(G)), & + optional, intent(out) :: ent_maxF !< The value of ent at that maximum, in H. + logical, dimension(SZI_(G)), & + optional, intent(in) :: do_i_in !< A logical array indicating which columns + !! to work on. + real, dimension(SZI_(G)), & + optional, intent(out) :: F_lim_maxent !< If present, do not apply the limit in + !! finding the maximum value, but return the + !! limited value at ent=max_ent_in in this + !! array, in H. + real, dimension(SZI_(G)), & + optional, intent(in) :: F_thresh !< If F_thresh is present, return the first + !! value found that has F > F_thresh, or + !! the maximum. ! Maximize F = ent*ds_kb*I_dSkbp1 in the range min_ent < ent < max_ent. ! ds_kb may itself be limited to positive values in determine_dSkb, which gives diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 502f05e3e1..a573f522e4 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -100,14 +100,15 @@ module MOM_opacity contains subroutine set_opacity(optics, fluxes, G, GV, CS) - type(optics_type), intent(inout) :: optics - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(opacity_CS), pointer :: CS !< The control structure earlier set up by - !! opacity_init. + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(opacity_CS), pointer :: CS !< The control structure earlier set up by + !! opacity_init. ! Arguments: (inout) opacity - The inverse of the vertical absorption decay ! scale for penetrating shortwave radiation, in m-1. @@ -147,21 +148,20 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) ! Make sure there is no division by 0. inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_z, & GV%H_to_m*GV%H_subroundoff) -!$OMP parallel default(none) shared(is,ie,js,je,nz,optics,inv_sw_pen_scale,fluxes,CS,Inv_nbands,GV) if ( CS%Opacity_scheme == DOUBLE_EXP ) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & 0.1*GV%Angstrom_z,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) @@ -172,22 +172,21 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) optics%opacity_band(n,i,j,k) = inv_sw_pen_scale enddo ; enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * fluxes%sw(i,j) enddo ; enddo ; enddo endif endif -!$OMP end parallel endif if (query_averaging_enabled(CS%diag)) then if (CS%id_sw_pen > 0) then -!$OMP parallel do default(none) shared(is,ie,js,je,Pen_SW_tot,optics) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie Pen_SW_tot(i,j) = 0.0 do n=1,optics%nbands @@ -198,7 +197,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) endif if (CS%id_sw_vis_pen > 0) then if (CS%opacity_scheme == MANIZZA_05) then -!$OMP parallel do default(none) shared(is,ie,js,je,Pen_SW_tot,optics) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie Pen_SW_tot(i,j) = 0.0 do n=1,min(optics%nbands,2) @@ -206,7 +205,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) enddo enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,Pen_SW_tot,optics) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie Pen_SW_tot(i,j) = 0.0 do n=1,optics%nbands @@ -217,7 +216,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then -!$OMP parallel do default(none) shared(nz,is,ie,js,je,tmp,optics,n) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie tmp(i,j,k) = optics%opacity_band(n,i,j,k) enddo ; enddo ; enddo @@ -229,21 +228,16 @@ end subroutine set_opacity subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) - type(optics_type), intent(inout) :: optics - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(opacity_CS), pointer :: CS !< The control structure. + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(opacity_CS), pointer :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in), optional :: chl_in !< A 3-d field of chlorophyll A, - !! in mg m-3. -! Arguments: fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (out) opacity - The inverse of the vertical absorption decay -! scale for penetrating shortwave radiation, in m-1. -! (in) G - The ocean's grid structure. -! (in) chl_in - A 3-d field of chlorophyll A, in mg m-3. + optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, + !! in mg m-3. real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in ! a layer, in mg/m^3. @@ -476,7 +470,8 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) target, intent(in) :: tracer_flow type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. - type(optics_type), pointer :: optics + type(optics_type), pointer :: optics !< An optics structure that has parameters + !! set and arrays allocated here. ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -674,8 +669,8 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS), pointer :: CS - type(optics_type), pointer, optional :: optics + type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. + type(optics_type), optional, pointer :: optics !< An optics type structure that should be deallocated. if (associated(CS%id_opacity)) deallocate(CS%id_opacity) if (associated(CS)) deallocate(CS) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 90401313dc..5148be3379 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1617,12 +1617,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) do_any_shelf = .false. if (associated(forces%frac_shelf_v)) then - do I=Is,Ie + do i=is,ie if (forces%frac_shelf_v(i,J)*G%mask2dCv(i,J) == 0.0) then - do_i(I) = .false. + do_i(i) = .false. visc%tbl_thick_shelf_v(i,J) = 0.0 ; visc%kv_tbl_shelf_v(i,J) = 0.0 else - do_i(I) = .true. ; do_any_shelf = .true. + do_i(i) = .true. ; do_any_shelf = .true. endif enddo endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 5524ef074a..9ecf1374ef 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -553,8 +553,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') - CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') + CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & + 'Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & + 'scaled by N2_bot/N2_meanz', 'm') CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -649,7 +651,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff - real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] + ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) type(tidal_mixing_diags), pointer :: dd is = G%isc ; ie = G%iec @@ -1326,5 +1329,4 @@ subroutine tidal_mixing_end(CS) end subroutine tidal_mixing_end - end module MOM_tidal_mixing diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4fc0c276df..4226e4fa8c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -156,11 +156,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & !! equations for diagnostics type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure - !> Zonal bottom stress from ocean to rock in Pa - real, optional, intent(out), dimension(SZIB_(G),SZJ_(G)) :: taux_bot - !> Meridional bottom stress from ocean to rock in Pa - real, optional, intent(out), dimension(SZI_(G),SZJB_(G)) :: tauy_bot - type(wave_parameters_CS), pointer, optional :: Waves !< Container for wave/Stokes information + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock in Pa + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock in Pa + type(wave_parameters_CS), & + optional, pointer :: Waves !< Container for wave/Stokes information ! Fields from forces used in this subroutine: ! taux: Zonal wind stress in Pa. diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 80c2cc2c3c..d0163f2804 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -79,8 +79,10 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, & restart_CS) type(hor_index_type), intent(in) :: HI ! This subroutine find the global min and max of either of all !! available tracer concentrations, or of a tracer that is being !! requested specifically, returning the number of tracers it has gone through. - function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax , G, CS, names, units) + function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, & + xgmax, ygmax, zgmax , G, CS, names, units) use mpp_utilities_mod, only: mpp_array_global_min_max - integer, intent(in) :: ind_start - logical, dimension(:), intent(out) :: got_minmax - real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg - !! times concentration units. - real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg - !! times concentration units. - real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. - integer :: MOM_generic_tracer_min_max !< Return value, the - !! number of tracers done here. + integer, intent(in) :: ind_start + logical, dimension(:), intent(out) :: got_minmax + real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg + !! times concentration units. + real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg + !! times concentration units. + real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + integer :: MOM_generic_tracer_min_max !< Return value, the + !! number of tracers done here. ! Local variables type(g_tracer_type), pointer :: g_tracer, g_tracer_next @@ -709,7 +713,8 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg call mpp_array_global_min_max(tr_ptr, grid_tmask,isd,jsd,isc,iec,jsc,jec,nk , gmin(m), gmax(m), & - G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), xgmax(m), ygmax(m), zgmax(m)) + G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), & + xgmax(m), ygmax(m), zgmax(m)) got_minmax(m) = .true. @@ -775,7 +780,7 @@ end subroutine MOM_generic_tracer_surface_state !ALL PE subroutine on Ocean! Due to otpm design the fluxes should be initialized like this on ALL PE's! subroutine MOM_generic_flux_init(verbosity) - integer, intent(in), optional :: verbosity !< A 0-9 integer indicating a level of verbosity. + integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. integer :: ind character(len=fm_string_len) :: g_tracer_name,longname, package,units,old_package,file_in,file_out diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 5fb99a448b..17a39b290c 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -51,13 +51,17 @@ module MOM_neutral_diffusion ! Positions of neutral surfaces in both the u, v directions real, allocatable, dimension(:,:,:) :: uPoL ! Non-dimensional position with left layer uKoL-1, u-point real, allocatable, dimension(:,:,:) :: uPoR ! Non-dimensional position with right layer uKoR-1, u-point - integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, u-point - integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, u-point + integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, + ! at a u-point + integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, + ! at a u-point real, allocatable, dimension(:,:,:) :: uHeff ! Effective thickness at u-point (H units) real, allocatable, dimension(:,:,:) :: vPoL ! Non-dimensional position with left layer uKoL-1, v-point real, allocatable, dimension(:,:,:) :: vPoR ! Non-dimensional position with right layer uKoR-1, v-point - integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, v-point - integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, v-point + integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, + ! at a v-point + integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, + ! at a v-point real, allocatable, dimension(:,:,:) :: vHeff ! Effective thickness at v-point (H units) ! Coefficients of polynomial reconstructions for temperature and salinity real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature @@ -74,7 +78,8 @@ module MOM_neutral_diffusion real, allocatable, dimension(:,:,:,:) :: dRdT_i ! dRho/dT (kg/m3/degC) at top edge real, allocatable, dimension(:,:,:,:) :: dRdS_i ! dRho/dS (kg/m3/ppt) at top edge integer, allocatable, dimension(:,:) :: ns ! Number of interfacs in a column - logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt to the next cell + logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt + ! to the next cell type(diag_ctrl), pointer :: diag ! structure to regulate output integer :: id_uhEff_2d = -1 @@ -372,9 +377,10 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) endif enddo ; enddo - ! Continuous reconstructions calculate hEff as the difference between the pressures of the neutral surfaces which - ! need to be reconverted to thickness units. The discontinuous version calculates hEff from the fraction of the - ! nondimensional fraction of the layer occupied by the + ! Continuous reconstructions calculate hEff as the difference between the pressures of the + ! neutral surfaces which need to be reconverted to thickness units. The discontinuous version + ! calculates hEff from the fraction of the nondimensional fraction of the layer occupied by + ! the... (Please finish this thought. -RWH) if (CS%continuous_reconstruction) then do k = 1, CS%nsurf-1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec if (G%mask2dCu(I,j) > 0.) CS%uhEff(I,j,k) = CS%uhEff(I,j,k) * pa_to_H @@ -408,7 +414,8 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H units) real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points (m^2) real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at u-points (m^2) - real, intent(in) :: dt !< Tracer time step * I_numitts (I_numitts in tracer_hordiff) + real, intent(in) :: dt !< Tracer time step * I_numitts + !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure @@ -799,8 +806,8 @@ end function fvlsq_slope !> Returns positions within left/right columns of combined interfaces using continuous reconstructions of T/S -subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, dRdTr, dRdSr, PoL, & - PoR, KoL, KoR, hEff) +subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, & + dRdTr, dRdSr, PoL, PoR, KoL, KoR, hEff) integer, intent(in) :: nk !< Number of levels real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure (Pa) real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature (degC) @@ -812,8 +819,10 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity (ppt) real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT (kg/m3/degC) real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS (kg/m3/ppt) - real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within layer KoL of left column - real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within layer KoR of right column + real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within + !! layer KoL of left column + real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within + !! layer KoR of right column integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) @@ -979,10 +988,10 @@ end subroutine find_neutral_surface_positions_continuous !> Higher order version of find_neutral_surface_positions. Returns positions within left/right columns !! of combined interfaces using intracell reconstructions of T/S -subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, & - Pres_l, hcol_l, Tl, Sl, dRdT_l, dRdS_l, stable_l, Pres_r, hcol_r, Tr, Sr, dRdT_r, dRdS_r, stable_r, & +subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol_l, Tl, Sl, & + dRdT_l, dRdS_l, stable_l, Pres_r, hcol_r, Tr, Sr, dRdT_r, dRdS_r, stable_r, & PoL, PoR, KoL, KoR, hEff, ppoly_T_l, ppoly_S_l, ppoly_T_r, ppoly_S_r) - type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure + type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces real, dimension(nk+1), intent(in) :: Pres_l !< Left-column interface pressure (Pa) @@ -1006,10 +1015,14 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, integer, dimension(4*nk), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(4*nk), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction ! Local variables integer :: k_surface ! Index of neutral surface @@ -1063,10 +1076,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, ! Loop over each neutral surface, working from top to bottom neutral_surfaces: do k_surface = 1, ns ! Potential density difference, rho(kr) - rho(kl) - dRho = 0.5 * & - ( ( dRdT_r(kl_right,ki_right) + dRdT_l(kl_left,ki_left) ) * ( Tr(kl_right,ki_right) - Tl(kl_left,ki_left) ) & - + ( dRdS_r(kl_right,ki_right) + dRdS_l(kl_left,ki_left) ) * ( Sr(kl_right,ki_right) - Sl(kl_left,ki_left) ) ) - if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & + dRho = 0.5 * ( ( dRdT_r(kl_right,ki_right) + dRdT_l(kl_left,ki_left) ) * & + ( Tr(kl_right,ki_right) - Tl(kl_left,ki_left) ) & + + ( dRdS_r(kl_right,ki_right) + dRdS_l(kl_left,ki_left) ) * & + ( Sr(kl_right,ki_right) - Sl(kl_left,ki_left) ) ) + if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & "kl_left=",kl_left, " ki_left=",ki_left," kl_right=",kl_right, " ki_right=",ki_right ! Which column has the lighter surface for the current indexes, kr and kl if (.not. reached_bottom) then @@ -1077,7 +1091,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, searching_right_column = .true. searching_left_column = .false. else ! dRho == 0. - if ( ( kl_left == kl_left_0) .and. ( kl_right == kl_right_0 ) .and. (ki_left + ki_right == 2) ) then ! Still at surface + if ( ( kl_left == kl_left_0) .and. ( kl_right == kl_right_0 ) .and. & + (ki_left + ki_right == 2) ) then ! Still at surface searching_left_column = .true. searching_right_column = .false. else ! Not the surface so we simply change direction @@ -1103,7 +1118,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, call drho_at_pos(CS%ndiff_aux_CS, T_other, S_other, dRdT_other, dRdS_other, Pres_l(kl_left), & Pres_l(kl_left+1), ppoly_T_l(kl_left,:), ppoly_S_l(kl_left,:), lastP_left, dRhoTop) else - dRhoTop = calc_drho(Tl(kl_left,1), Sl(kl_left,1), dRdT_l(kl_left,1), dRdS_l(kl_left,1), T_other, S_other, & + dRhoTop = calc_drho(Tl(kl_left,1), Sl(kl_left,1), dRdT_l(kl_left,1), dRdS_l(kl_left,1), T_other, S_other, & dRdT_other, dRdS_other) endif ! Potential density difference, rho(kl) - rho(kl_right,ki_right) (will be positive) @@ -1123,8 +1138,9 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, KoR(k_surface) = kl_right ! Set position within the searched column - call search_other_column(dRhoTop, dRhoBot, Pres_l(kl_left), Pres_l(kl_left+1), lastP_left, lastK_left, kl_left, & - kl_left_0, ki_left, top_connected_l, bot_connected_l, PoL(k_surface), KoL(k_surface), search_layer) + call search_other_column(dRhoTop, dRhoBot, Pres_l(kl_left), Pres_l(kl_left+1), & + lastP_left, lastK_left, kl_left, kl_left_0, ki_left, & + top_connected_l, bot_connected_l, PoL(k_surface), KoL(k_surface), search_layer) if ( CS%refine_position .and. search_layer ) then min_bound = 0. @@ -1137,7 +1153,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, endif if (PoL(k_surface) == 0.) top_connected_l(KoL(k_surface)) = .true. if (PoL(k_surface) == 1.) bot_connected_l(KoL(k_surface)) = .true. - call increment_interface(nk, kl_right, ki_right, stable_r, reached_bottom, searching_right_column, searching_left_column) + call increment_interface(nk, kl_right, ki_right, stable_r, reached_bottom, & + searching_right_column, searching_left_column) elseif (searching_right_column) then if (CS%ref_pres>=0.) then @@ -1189,7 +1206,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, endif if (PoR(k_surface) == 0.) top_connected_r(KoR(k_surface)) = .true. if (PoR(k_surface) == 1.) bot_connected_r(KoR(k_surface)) = .true. - call increment_interface(nk, kl_left, ki_left, stable_l, reached_bottom, searching_left_column, searching_right_column) + call increment_interface(nk, kl_left, ki_left, stable_l, reached_bottom, & + searching_left_column, searching_right_column) else stop 'Else what?' @@ -1197,8 +1215,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, lastK_left = KoL(k_surface) ; lastP_left = PoL(k_surface) lastK_right = KoR(k_surface) ; lastP_right = PoR(k_surface) - if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), " KoR:", & - KoR(k_surface), " PoR:", PoR(k_surface) + if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & + " KoR:", KoR(k_surface), " PoR:", PoR(k_surface) ! Effective thickness if (k_surface>1) then ! This is useful as a check to make sure that positions are monotonically increasing @@ -1364,7 +1382,7 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K dT_bottom = T_right_bottom - T_left_bottom dT_ave = 0.5 * ( dT_top + dT_bottom ) dT_layer = T_right_layer - T_left_layer - if (signum(1.,dT_top) * signum(1.,dT_bottom) <= 0. .or. signum(1.,dT_ave) * signum(1.,dT_layer) <= 0. ) then + if (signum(1.,dT_top) * signum(1.,dT_bottom) <= 0. .or. signum(1.,dT_ave) * signum(1.,dT_layer) <= 0.) then dT_ave = 0. else dT_ave = dT_layer @@ -1372,10 +1390,12 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K Flx(k_sublayer) = dT_ave * hEff(k_sublayer) else ! Discontinuous reconstruction ! Calculate tracer values on left and right side of the neutral surface - call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, ppoly_r_coeffs_l, & - T_left_top, T_left_bottom, T_left_sub, T_left_top_int, T_left_bot_int, T_left_layer) - call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoR, PiR, Tr, Tid_r, deg, iMethod, ppoly_r_coeffs_r, & - T_right_top, T_right_bottom, T_right_sub, T_right_top_int, T_right_bot_int, T_right_layer) + call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, & + ppoly_r_coeffs_l, T_left_top, T_left_bottom, T_left_sub, & + T_left_top_int, T_left_bot_int, T_left_layer) + call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoR, PiR, Tr, Tid_r, deg, iMethod, & + ppoly_r_coeffs_r, T_right_top, T_right_bottom, T_right_sub, & + T_right_top_int, T_right_bot_int, T_right_layer) dT_top = T_right_top - T_left_top dT_bottom = T_right_bottom - T_left_bottom @@ -2048,9 +2068,11 @@ logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) if (test_ifndp) stdunit = 0 ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_ifndp) then - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' + write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') & + 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' else - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue + write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') & + 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue endif endif @@ -2079,10 +2101,12 @@ logical function test_data1d(verbose, nk, Po, Ptrue, title) do k = 1,nk if (Po(k) /= Ptrue(k)) then test_data1d = .true. - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' + write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') & + 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' else if (verbose) & - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) + write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') & + 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) endif enddo endif @@ -2122,7 +2146,8 @@ logical function test_data1di(verbose, nk, Po, Ptrue, title) end function test_data1di -!> Returns true if output of find_neutral_surface_positions() does not match correct values, and conditionally writes results to stream +!> Returns true if output of find_neutral_surface_positions() does not match correct values, +!! and conditionally writes results to stream logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, pR0, hEff0, title) logical, intent(in) :: verbose !< If true, write results to stdout integer, intent(in) :: ns !< Number of surfaces diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index 09ed0c0e58..ca3435ded0 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -328,8 +328,10 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) else ! dRhoPos - dRhoNeg < 0 interpolate_for_nondim_position = 0.5 endif - if ( interpolate_for_nondim_position < 0. ) stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' - if ( interpolate_for_nondim_position > 1. ) stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' + if ( interpolate_for_nondim_position < 0. ) & + stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' + if ( interpolate_for_nondim_position > 1. ) & + stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' end function interpolate_for_nondim_position !> Use root-finding methods to find where dRho = 0, based on the equation of state and the polynomial @@ -339,8 +341,8 @@ end function interpolate_for_nondim_position !! to see if it it diverges outside the interval. In that case (or in the case that second derivatives are not !! available), Brent's method is used following the implementation found at !! https://people.sc.fsu.edu/~jburkardt/f_src/brent/brent.f90 -real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, ppoly_T, ppoly_S, drho_top, & - drho_bot, min_bound) +real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, & + ppoly_T, ppoly_S, drho_top, drho_bot, min_bound) type(ndiff_aux_CS_type), intent(in) :: CS !< Control structure with parameters for this module real, intent(in) :: T_ref !< Temperature of the neutral surface at the searched from interface real, intent(in) :: S_ref !< Salinity of the neutral surface at the searched from interface diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index db54e599c6..405c7e87d0 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -47,21 +47,29 @@ module MOM_tracer_advect !! monotonic, conservative, weakly diffusive scheme. subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) - type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used - real, intent(in) :: dt !< time increment (seconds) - type(tracer_advect_CS), pointer :: CS !< control structure for module - type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) - integer, optional :: max_iter_in - logical, optional :: x_first_in - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_out !< layer thickness before advection (m or kg m-2) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_end !< layer thickness after advection (m or kg m-2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used + real, intent(in) :: dt !< time increment (seconds) + type(tracer_advect_CS), pointer :: CS !< control structure for module + type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: h_prev_opt !< layer thickness before advection (m or kg m-2) + integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations + logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update + !! first in the x- or y-direction. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: h_out !< layer thickness before advection (m or kg m-2) type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index e68ff0df9e..f8762985c5 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -24,19 +24,24 @@ module MOM_tracer_diabatic subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer above (units of h_work) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer below (units of h_work) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) - real, intent(in) :: dt !< amount of time covered by this call (seconds) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer (in CU * kg m-2 s-1) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the tracer, - !! in units of (CU * kg m-2 s-1) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir (units of CU kg m-2; formerly CU m) - real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 - logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs to be integrated in time + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer + !! above (units of h_work) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer + !! below (units of h_work) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) + real, intent(in) :: dt !< amount of time covered by this call (seconds) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units + !! of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the + !! tracer, in units of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir + !! (units of CU kg m-2; formerly CU m) + real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 + logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs + !! to be integrated in time real :: sink_dist ! The distance the tracer sinks in a time step, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -227,10 +232,10 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units real, intent(in ) :: evap_CFL_limit real, intent(in ) :: minimum_forcing_depth - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated amount of tracer! - ! that leaves with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated + !! amount of tracer that enters with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated + !! amount of tracer that leaves with freshwater !< Optional flag to determine whether h should be updated logical, optional, intent(in) :: update_h_opt @@ -245,13 +250,13 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim netMassIn, & ! mass entering ocean surface (H units) over a time step netMassOut ! mass leaving ocean surface (H units) over a time step - real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d - real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! - ! that leaves with freshwater - real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d - real :: hGrounding(maxGroundings) + real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d + real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! + ! that enters with freshwater + real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! + ! that leaves with freshwater + real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d + real :: hGrounding(maxGroundings) real :: Tr_in logical :: update_h integer :: i, j, is, ie, js, je, k, nz, n, nsw diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index f7fd35d721..491803c4e5 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -87,24 +87,30 @@ module MOM_tracer_hor_diff !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) - type(ocean_grid_type), intent(inout) :: G !< Grid type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) - real, intent(in) :: dt !< time step (seconds) - type(MEKE_type), pointer :: MEKE !< MEKE type - type(VarMix_CS), pointer :: VarMix !< Variable mixing type - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(tracer_hor_diff_CS), pointer :: CS !< module control structure - type(tracer_registry_type), pointer :: Reg !< registered tracers - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temp and - !! salinity or mixed layer density. Absent fields have - !! NULL ptrs, and these may (probably will) point to - !! some of the same arrays as Tr does. tv is required - !! for epipycnal mixing between mixed layer and the interior. + type(ocean_grid_type), intent(inout) :: G !< Grid type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness (m or kg m-2) + real, intent(in) :: dt !< time step (seconds) + type(MEKE_type), pointer :: MEKE !< MEKE type + type(VarMix_CS), pointer :: VarMix !< Variable mixing type + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(tracer_hor_diff_CS), pointer :: CS !< module control structure + type(tracer_registry_type), pointer :: Reg !< registered tracers + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available + !! thermodynamic fields, including potential temp and + !! salinity or mixed layer density. Absent fields have + !! NULL ptrs, and these may (probably will) point to + !! some of the same arrays as Tr does. tv is required + !! for epipycnal mixing between mixed layer and the interior. ! Optional inputs for offline tracer transport - logical, optional :: do_online_flag - real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: read_khdt_x - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: read_khdt_y + logical, optional, intent(in) :: do_online_flag !< If present and true, do online + !! tracer transport with stored velcities. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: read_khdt_x !< If present, these are the zonal + !! diffusivities from previous run. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: read_khdt_y !< If present, these are the meridional + !! diffusivities from previous run. real, dimension(SZI_(G),SZJ_(G)) :: & diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index b7a1e1a421..daa2062c81 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -158,10 +158,14 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit real, dimension(:,:,:), optional, pointer :: ad_y !< diagnostic y-advective flux (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: df_x !< diagnostic x-diffusive flux (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: df_y !< diagnostic y-diffusive flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux + !! (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: advection_xy !< convergence of lateral advective tracer fluxes logical, optional, intent(in) :: registry_diags !< If present and true, use the registry for @@ -173,12 +177,15 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit character(len=*), optional, intent(in) :: flux_units !< The units for the fluxes of this tracer. real, optional, intent(in) :: flux_scale !< A scaling factor used to convert the fluxes !! of this tracer to its desired units. - character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of this tracer. + character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of + !! this tracer. real, optional, intent(in) :: convergence_scale !< A scaling factor used to convert the flux !! convergence of this tracer to its desired units. - character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated tendencies of this tracer. - integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the character - !! string template to use in labeling diagnostics + character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated + !! tendencies of this tracer. + integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the + !! character string template to use in + !! labeling diagnostics type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure; !! this tracer will be registered for !! restarts if this argument is present diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 03cf06fdfa..ef8abe9bbf 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -67,12 +67,12 @@ module boundary_impulse_tracer !> Read in runtime options and add boundary impulse tracer to tracer registry function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in ) :: HI - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters - type(boundary_impulse_tracer_CS), pointer, intent(inout) :: CS - type(tracer_registry_type), pointer, intent(inout) :: tr_Reg - type(MOM_restart_CS), pointer, intent(inout) :: restart_CS + type(hor_index_type), intent(in ) :: HI + type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters + type(boundary_impulse_tracer_CS), pointer :: CS + type(tracer_registry_type), pointer :: tr_Reg + type(MOM_restart_CS), pointer :: restart_CS ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -170,7 +170,8 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(boundary_impulse_tracer_CS), pointer,intent(inout) :: CS type(sponge_CS), pointer, intent(inout) :: sponge_CSp type(diag_to_Z_CS), pointer, intent(inout) :: diag_to_Z_CSp - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables + type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various + !! thermodynamic variables ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -227,16 +228,17 @@ end subroutine initialize_boundary_impulse_tracer ! Apply source or sink at boundary and do vertical diffusion subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h_old, h_new, ea, eb - type(forcing), intent(in ) :: fluxes - real, intent(in ) :: dt !< The amount of time covered by this call, in s - type(boundary_impulse_tracer_CS), pointer, intent(inout) :: CS - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables - logical, intent(in ) :: debug - real, optional, intent(in ) :: evap_CFL_limit - real, optional, intent(in ) :: minimum_forcing_depth + type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h_old, h_new, ea, eb + type(forcing), intent(in ) :: fluxes + real, intent(in ) :: dt !< The amount of time covered by this call, in s + type(boundary_impulse_tracer_CS), pointer :: CS + type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various + !! thermodynamic variables + logical, intent(in ) :: debug + real, optional, intent(in ) :: evap_CFL_limit + real, optional, intent(in ) :: minimum_forcing_depth ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 2f84fc7dfa..8e6443ae4a 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -42,10 +42,11 @@ module BFB_initialization contains +!> This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. +!! This case is set up in such a way that the temperature of the topmost layer is equal to the SST at the +!! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers +!! and linearly interpolated for the intermediate layers. subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) -! This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. This case is set up in -! such a way that the temperature of the topmost layer is equal to the SST at the southern edge of the domain. The temperatures are -! then converted to densities of the top and bottom layers and linearly interpolated for the intermediate layers. real, dimension(NKMEM_), intent(out) :: Rlay, g_prime type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -83,9 +84,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) end subroutine BFB_set_coord +!> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs +!! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h) -! This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs within 2 degrees lat of the -! boundary. The damping linearly decreases northward over the next 2 degrees. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure logical, intent(in) :: use_temperature type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -129,7 +130,10 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo ! Use for meridional thickness profile initialization + + ! Use for meridional thickness profile initialization +! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo + do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 elseif (G%geoLatT(i,j) < slat+4.0) then diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index c9b47d595f..b8d46798e4 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -218,7 +218,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par enddo enddo ; enddo - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) @@ -552,7 +552,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) enddo enddo ; enddo - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ac83add05c..ed7e726f8e 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -612,7 +612,7 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) Bottom = Bottom - GV%H_to_m * (h(ii,jj,kk)+h(ii,jjm1,kk))/2. call DHH85_mid(CS,GV,ustar(ii,jj),Midpoint,US) ! Putting into x-direction for now - CS%US_x(:,:,kk) = US + CS%US_x(ii,jj,kk) = US enddo enddo enddo @@ -626,7 +626,7 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) Bottom = Bottom - GV%H_to_m * (h(ii,jj,kk)+h(ii,jjm1,kk))/2. call DHH85_mid(CS,GV,ustar(ii,jj),Midpoint,US) ! Putting into x-direction for now - CS%US_y(:,:,kk) = 0.0 + CS%US_y(ii,jj,kk) = 0.0 !### Note that =0 should be =US - RWH enddo enddo enddo @@ -1125,12 +1125,12 @@ end subroutine DHH85_mid ! Do not use. subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. ! Local variables REAL :: dTauUp, dTauDn, DVel @@ -1200,13 +1200,13 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) ! Work towards an explicit Coriolis Stokes method. ! perhaps not the best way forward, not accessed in the code. ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) - type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) + type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. ! Local variables REAL :: DVel @@ -1215,7 +1215,8 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) + DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) u(i,j,k) = u(i,j,k)+DVEL*DT enddo enddo @@ -1224,7 +1225,8 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) + DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) v(i,j,k) = v(i,j,k)-DVEL*DT enddo enddo diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index d22d7457ab..51c8ab7683 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -60,15 +60,15 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) ! This sets topography that has a reentrant channel to the south. D(i,j) = 1.0 - (1.2 * spike(x,0.2) + 1.2 * spike(x-1.0,0.2)) * spike(MIN(0.0,y-0.3),0.2) & !< South America - - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa - - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica - - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula - - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge - - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East - - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North - - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South - - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness - - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness + - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa + - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica + - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula + - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge + - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East + - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North + - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South + - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness + - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness if (D(i,j) < 0.0) D(i,j) = 0.0 D(i,j) = D(i,j) * max_depth diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index acf13d8fd8..88b80e84c6 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -95,7 +95,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -138,7 +138,8 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: S_surf - S_range * z/max_depth = S_light + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: - S_range * z/max_depth = S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range - e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * ( (real(K)-1.5) / real(nz-1) ) ) / S_range + e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & + ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 80376e67c9..2eeda73243 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -6,7 +6,7 @@ module dumbbell_surface_forcing !* * !* * !* This file contains subroutines for specifying surface dynamic * -!* forcing for the dumbbell case. * +!* forcing for the dumbbell case. * !* * !********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled @@ -230,8 +230,10 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = CS%forcing_mask(i,j)* CS%slp_amplitude * G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) - fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) + fluxes%p_surf(i,j) = CS%forcing_mask(i,j)* CS%slp_amplitude * & + G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) + fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * & + G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) enddo; enddo @@ -251,10 +253,10 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) end subroutine alloc_if_needed subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(in) :: diag type(dumbbell_surface_forcing_CS), pointer :: CS ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 8160a45002..790185d0ee 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -96,7 +96,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -139,7 +139,8 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: S_surf - S_range * z/max_depth = S_light + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: - S_range * z/max_depth = S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range - e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * ( (real(K)-1.5) / real(nz-1) ) ) / S_range + e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & + ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom