From dbb82e65c33016b4ba5f6f67c0fd47f8002cdf40 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 May 2024 03:53:18 -0400 Subject: [PATCH] +(*)Fix rotation of coupler_type variables This commit adds the necessary information about the turns of the model grid relative to the (unrotated) coupler_type data fields that are inside of the forcing type and surface_state type and are used with passive tracers, so that certain tracer packages can now be used with rotated grids. The previous version had problems where the model would not run when ROTATE_INTEX = True and the CFCs (and probably other passive tracers) were being used, as noted at NOAA-GFDL/MOM6/issues/621. These problems have now been fixed. There are new calls to coupler_type_spawn() in allocate_forcing_by_ref() and allocate_surface_state() that manage the creation of the coupler_2d_bt_types for unrotated types based on information from their rotated counterparts. There is a new optional turns arguments to allocate_forcing_by_ref() and new optional sfc_state_in and turns arguments to allocate_surface_state(), and these are now being used in at least 6 places where unrotated temporary surface_state or forcing types are being set up. There are also new optional turns argument to extract_coupler_type_data() and set_coupler_type_data() that are used to deal with the fact that the internal data arrays in the coupler_bc_types are never rotated, unlike the other MOM6 arrays, because they have to be passed directly into the generic tracer code. These new turns arguments are used in 14 calls from various tracer packages, including in 6 calls from the OCMIP2_CFC code. There are 4 new calls to deallocate_surface_state() or deallocate_forcing_type() that were added to avoid (presumably minor) memory leaks when grid rotation is enabled. These new calls are in initialize_ice_shelf_fluxes(), shelf_calc_flux() and in the surface flux diagnostics section of step_MOM(). All answers are bitwise identical in any cases that worked previously, but some cases with grid rotation that previously were failing with cryptic error messages are now running successfully. There are new optional arguments to several publicly visible routines. --- src/core/MOM.F90 | 11 ++-- src/core/MOM_forcing_type.F90 | 22 ++++++-- src/core/MOM_variables.F90 | 50 ++++++++++++------ src/framework/MOM_coupler_types.F90 | 71 ++++++++++++++++++++++---- src/ice_shelf/MOM_ice_shelf.F90 | 34 +++++++----- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 12 ++--- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- 14 files changed, 157 insertions(+), 59 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 397a4e4059..42e675d41f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -624,7 +624,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call rotate_mech_forcing(forces_in, turns, forces) allocate(fluxes) - call allocate_forcing_type(fluxes_in, G, fluxes) + call allocate_forcing_type(fluxes_in, G, fluxes, turns=turns) call rotate_forcing(fluxes_in, fluxes, turns) else forces => forces_in @@ -1044,6 +1044,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Do diagnostics that only occur at the end of a complete forcing step. if (cycle_end) then + if (showCallTree) call callTree_waypoint("Do cycle end diagnostics (step_MOM)") if (CS%rotate_index) then allocate(sfc_state_diag) call rotate_surface_state(sfc_state, sfc_state_diag, G, turns) @@ -1063,6 +1064,10 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) + if (CS%rotate_index) then + call deallocate_surface_state(sfc_state_diag) + endif + if (showCallTree) call callTree_waypoint("Done with end cycle diagnostics (step_MOM)") endif ! Accumulate the surface fluxes for assessing conservation @@ -3710,8 +3715,8 @@ subroutine extract_surface_state(CS, sfc_state_in) if (CS%rotate_index) then allocate(sfc_state) call allocate_surface_state(sfc_state, G, use_temperature, & - do_integrals=.true., omit_frazil=.not.associated(CS%tv%frazil),& - use_iceshelves=use_iceshelves) + do_integrals=.true., omit_frazil=.not.associated(CS%tv%frazil),& + use_iceshelves=use_iceshelves, sfc_state_in=sfc_state_in, turns=turns) else sfc_state => sfc_state_in endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 72c67253ed..83b4ea17cd 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -6,7 +6,7 @@ module MOM_forcing_type use MOM_array_transform, only : rotate_array, rotate_vector, rotate_array_pair use MOM_coupler_types, only : coupler_2d_bc_type, coupler_type_destructor use MOM_coupler_types, only : coupler_type_increment_data, coupler_type_initialized -use MOM_coupler_types, only : coupler_type_copy_data +use MOM_coupler_types, only : coupler_type_copy_data, coupler_type_spawn use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_debugging, only : hchksum, uvchksum use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field @@ -2627,7 +2627,7 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if (turns /= 0) then G => diag%G allocate(fluxes) - call allocate_forcing_type(fluxes_in, G, fluxes) + call allocate_forcing_type(fluxes_in, G, fluxes, turns=turns) call rotate_forcing(fluxes_in, fluxes, turns) else G => G_in @@ -3308,13 +3308,16 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & end subroutine allocate_forcing_by_group !> Allocate elements of a new forcing type based on their status in an existing type. -subroutine allocate_forcing_by_ref(fluxes_ref, G, fluxes) +subroutine allocate_forcing_by_ref(fluxes_ref, G, fluxes, turns) type(forcing), intent(in) :: fluxes_ref !< Reference fluxes type(ocean_grid_type), intent(in) :: G !< Grid metric of target fluxes type(forcing), intent(out) :: fluxes !< Target fluxes + integer, optional, intent(in) :: turns !< If present, the number of counterclockwise + !! quarter turns to use on the new grid. logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf logical :: do_iceberg, do_heat_added, do_buoy + logical :: even_turns ! True if turns is absent or even call get_forcing_groups(fluxes_ref, do_water, do_heat, do_ustar, do_taumag, do_press, & do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) @@ -3353,6 +3356,19 @@ subroutine allocate_forcing_by_ref(fluxes_ref, G, fluxes) ! This flag would normally be set by a control flag in allocate_forcing_type. ! Here we copy the flag from the reference forcing. fluxes%gustless_accum_bug = fluxes_ref%gustless_accum_bug + + if (coupler_type_initialized(fluxes_ref%tr_fluxes)) then + ! The data fields in the coupler_2d_bc_type are never rotated. + even_turns = .true. ; if (present(turns)) even_turns = (modulo(turns, 2) == 0) + if (even_turns) then + call coupler_type_spawn(fluxes_ref%tr_fluxes, fluxes%tr_fluxes, & + (/G%isc,G%isc,G%iec,G%iec/), (/G%jsc,G%jsc,G%jec,G%jec/)) + else + call coupler_type_spawn(fluxes_ref%tr_fluxes, fluxes%tr_fluxes, & + (/G%jsc,G%jsc,G%jec,G%jec/), (/G%isc,G%isc,G%iec,G%iec/)) + endif + endif + end subroutine allocate_forcing_by_ref diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index d5d20f0400..37c1607826 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -339,14 +339,14 @@ module MOM_variables !! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & gas_fields_ocn, use_meltpot, use_iceshelves, & - omit_frazil) + omit_frazil, sfc_state_in, turns) 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. type(coupler_1d_bc_type), & - optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean + optional, intent(in) :: gas_fields_ocn !< If present, this type describes the !! ocean and surface-ice fields that will participate !! in the calculation of additional gas or other !! tracer fluxes, and can be used to spawn related @@ -356,9 +356,20 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & !! under ice shelves. logical, optional, intent(in) :: omit_frazil !< If present and false, do not allocate the space to !! pass frazil fluxes to the coupler + type(surface), & + optional, intent(in) :: sfc_state_in !< If present and its tr_fields are initialized, + !! this type describes the ocean and surface-ice fields that + !! will participate in the calculation of additional gas or + !! other tracer fluxes, and can be used to spawn related + !! internal variables in the ice model. If gas_fields_ocn + !! is present, it is used and tr_fields_in is ignored. + integer, optional, intent(in) :: turns !< If present, the number of counterclockwise quarter + !! turns to use on the new grid. ! local variables logical :: use_temp, alloc_integ, use_melt_potential, alloc_iceshelves, alloc_frazil + logical :: even_turns ! True if turns is absent or even + integer :: tr_field_i_mem(4), tr_field_j_mem(4) integer :: is, ie, js, je, isd, ied, jsd, jed integer :: isdB, iedB, jsdB, jedB @@ -406,9 +417,22 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & allocate(sfc_state%tauy_shelf(isd:ied,JsdB:JedB), source=0.0) endif - if (present(gas_fields_ocn)) & + ! The data fields in the coupler_2d_bc_type are never rotated. + even_turns = .true. ; if (present(turns)) even_turns = (modulo(turns, 2) == 0) + if (even_turns) then + tr_field_i_mem(1:4) = (/is,is,ie,ie/) ; tr_field_j_mem(1:4) = (/js,js,je,je/) + else + tr_field_i_mem(1:4) = (/js,js,je,je/) ; tr_field_j_mem(1:4) = (/is,is,ie,ie/) + endif + if (present(gas_fields_ocn)) then call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + tr_field_i_mem, tr_field_j_mem, as_needed=.true.) + elseif (present(sfc_state_in)) then + if (coupler_type_initialized(sfc_state_in%tr_fields)) then + call coupler_type_spawn(sfc_state_in%tr_fields, sfc_state%tr_fields, & + tr_field_i_mem, tr_field_j_mem, as_needed=.true.) + endif + endif sfc_state%arrays_allocated = .true. @@ -439,10 +463,10 @@ end subroutine deallocate_surface_state !> Rotate the surface state fields from the input to the model indices. subroutine rotate_surface_state(sfc_state_in, sfc_state, G, turns) - type(surface), intent(in) :: sfc_state_in - type(surface), intent(inout) :: sfc_state - type(ocean_grid_type), intent(in) :: G - integer, intent(in) :: turns + type(surface), intent(in) :: sfc_state_in !< The input unrotated surface state type that is the data source. + type(surface), intent(inout) :: sfc_state !< The rotated surface state type whose arrays will be filled in + type(ocean_grid_type), intent(in) :: G !< The ocean grid structure + integer, intent(in) :: turns !< The number of counterclockwise quarter turns to use on the rotated grid. logical :: use_temperature, do_integrals, use_melt_potential, use_iceshelves @@ -455,13 +479,9 @@ subroutine rotate_surface_state(sfc_state_in, sfc_state, G, turns) .and. allocated(sfc_state_in%tauy_shelf) if (.not. sfc_state%arrays_allocated) then - call allocate_surface_state(sfc_state, G, & - use_temperature=use_temperature, & - do_integrals=do_integrals, & - use_meltpot=use_melt_potential, & - use_iceshelves=use_iceshelves & - ) - sfc_state%arrays_allocated = .true. + call allocate_surface_state(sfc_state, G, use_temperature=use_temperature, & + do_integrals=do_integrals, use_meltpot=use_melt_potential, & + use_iceshelves=use_iceshelves, sfc_state_in=sfc_state_in, turns=turns) endif if (use_temperature) then diff --git a/src/framework/MOM_coupler_types.F90 b/src/framework/MOM_coupler_types.F90 index 1baef24f76..b931a2ddd2 100644 --- a/src/framework/MOM_coupler_types.F90 +++ b/src/framework/MOM_coupler_types.F90 @@ -3,6 +3,7 @@ module MOM_coupler_types ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_array_transform, only : allocate_rotated_array, rotate_array use MOM_couplertype_infra, only : CT_spawn, CT_initialized, CT_destructor, atmos_ocn_coupler_flux use MOM_couplertype_infra, only : CT_set_diags, CT_send_data, CT_write_chksums, CT_data_override use MOM_couplertype_infra, only : CT_copy_data, CT_increment_data, CT_rescale_data @@ -363,7 +364,7 @@ end subroutine coupler_type_data_override !> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array, using a !! MOM-specific interface. subroutine extract_coupler_type_data(var_in, bc_index, array_out, scale_factor, & - halo_size, idim, jdim, field_index) + halo_size, idim, jdim, field_index, turns) type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract !! The internal data has arbitrary units [B]. integer, intent(in) :: bc_index !< The index of the boundary condition @@ -384,13 +385,35 @@ subroutine extract_coupler_type_data(var_in, bc_index, array_out, scale_factor, integer, optional, intent(in) :: field_index !< The index of the field in the boundary !! condition that is being copied, or the !! surface flux by default. - - if (present(field_index)) then - call CT_extract_data(var_in, bc_index, field_index, array_out, & + integer, optional, intent(in) :: turns !< The number of quarter-turns from the unrotated + !! coupler_2d_bt_type to model grid + + ! Local variables + real, allocatable :: array_unrot(:,:) ! Array on the unrotated grid in arbitrary units [A] + integer :: q_turns ! The number of quarter turns through which array_out is to be rotated + integer :: index, is, ie, js, je, halo + + index = ind_flux ; if (present(field_index)) index = field_index + q_turns = 0 ; if (present(turns)) q_turns = modulo(turns, 4) + halo = 0 ; if (present(halo_size)) halo = halo_size + + ! The case with non-trivial grid rotation is complicated by the fact that the data fields + ! in the coupler_2d_bc_type are never rotated, so they need to be handled separately. + if (q_turns == 0) then + call CT_extract_data(var_in, bc_index, index, array_out, & scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + elseif (present(idim) .and. present(jdim)) then + ! Work only on the computational domain plus symmetric halos. + is = idim(2)-halo ; ie = idim(3)+halo ; js = jdim(2)-halo ; je = jdim(3)+halo + call allocate_rotated_array(array_out(is:ie,js:je), [1,1], -q_turns, array_unrot) + call CT_extract_data(var_in, bc_index, index, array_unrot, scale_factor=scale_factor, halo_size=halo) + call rotate_array(array_unrot, q_turns, array_out(is:ie,js:je)) + deallocate(array_unrot) else - call CT_extract_data(var_in, bc_index, ind_flux, array_out, & - scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + call allocate_rotated_array(array_out, [1,1], -q_turns, array_unrot) + call CT_extract_data(var_in, bc_index, index, array_unrot, scale_factor=scale_factor, halo_size=halo) + call rotate_array(array_unrot, q_turns, array_out) + deallocate(array_unrot) endif end subroutine extract_coupler_type_data @@ -398,7 +421,7 @@ end subroutine extract_coupler_type_data !> Set single 2d field in coupler_2d_bc_type from a two-dimensional array, using a !! MOM-specific interface. subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_factor, & - halo_size, idim, jdim, field_index) + halo_size, idim, jdim, field_index, turns) real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field in !! arbitrary units [A]; the size of this array !! must match the size of the data being copied @@ -422,15 +445,43 @@ subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_fact integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being set. The !! surface concentration is set by default. + integer, optional, intent(in) :: turns !< The number of quarter-turns from the unrotated + !! coupler_2d_bt_type to model grid + ! Local variables + real, allocatable :: array_unrot(:,:) ! Array on the unrotated grid in the same arbitrary units + ! as array_in [A] integer :: subfield ! An integer indicating which field to set. + integer :: q_turns ! The number of quarter turns through which array_in is rotated + integer :: is, ie, js, je, halo + + q_turns = 0 ; if (present(turns)) q_turns = modulo(turns, 4) subfield = ind_csurf if (present(solubility)) then ; if (solubility) subfield = ind_alpha ; endif if (present(field_index)) subfield = field_index - - call CT_set_data(array_in, bc_index, subfield, var, & - scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + halo = 0 ; if (present(halo_size)) halo = halo_size + + ! The case with non-trivial grid rotation is complicated by the fact that the data fields + ! in the coupler_2d_bc_type are never rotated, so they need to be handled separately. + if (q_turns == 0) then + call CT_set_data(array_in, bc_index, subfield, var, & + scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + elseif (present(idim) .and. present(jdim)) then + ! Work only on the computational domain plus symmetric halos. + is = idim(2)-halo ; ie = idim(3)+halo ; js = jdim(2)-halo ; je = jdim(3)+halo + call allocate_rotated_array(array_in(is:ie,js:je), [1,1], -q_turns, array_unrot) + call rotate_array(array_in, -q_turns, array_unrot) + call CT_set_data(array_unrot, bc_index, subfield, var, & + scale_factor=scale_factor, halo_size=halo_size) + deallocate(array_unrot) + else + call allocate_rotated_array(array_in, [1,1], -q_turns, array_unrot) + call rotate_array(array_in, -q_turns, array_unrot) + call CT_set_data(array_in, bc_index, subfield, var, & + scale_factor=scale_factor, halo_size=halo_size) + deallocate(array_unrot) + endif end subroutine set_coupler_type_data diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 05c70a0ea1..a4b06b6150 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -41,9 +41,9 @@ module MOM_ice_shelf use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_transcribe_grid, only : rotate_dyngrid use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init, fix_restart_unit_scaling -use MOM_variables, only : surface, allocate_surface_state +use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : rotate_surface_state -use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum +use MOM_forcing_type, only : forcing, allocate_forcing_type, deallocate_forcing_type, MOM_forcing_chksum use MOM_forcing_type, only : mech_forcing, allocate_mech_forcing, MOM_mech_forcing_chksum use MOM_forcing_type, only : copy_common_forcing_fields, rotate_forcing, rotate_mech_forcing use MOM_get_input, only : directories, Get_MOM_input @@ -378,7 +378,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) allocate(sfc_state) call rotate_surface_state(sfc_state_in, sfc_state, CS%Grid, CS%turns) allocate(fluxes) - call allocate_forcing_type(fluxes_in, G, fluxes) + call allocate_forcing_type(fluxes_in, G, fluxes, turns=CS%turns) call rotate_forcing(fluxes_in, fluxes, CS%turns) else sfc_state => sfc_state_in @@ -916,14 +916,17 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) call cpu_clock_end(id_clock_shelf) + if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, CS%US, haloshift=0) + if (CS%rotate_index) then ! call rotate_surface_state(sfc_state, sfc_state_in, CS%Grid_in, -CS%turns) - call rotate_forcing(fluxes,fluxes_in,-CS%turns) + call rotate_forcing(fluxes, fluxes_in, -CS%turns) + call deallocate_surface_state(sfc_state) + deallocate(sfc_state) + call deallocate_forcing_type(fluxes) + deallocate(fluxes) endif - - if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, CS%US, haloshift=0) - end subroutine shelf_calc_flux subroutine integrate_over_ice_sheet_area(G, ISS, var, var_scale, var_out) @@ -1723,14 +1726,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, "buoyancy iteration.", units="nondim", default=1.0e-4) if (PRESENT(sfc_state_in)) then - allocate(sfc_state) ! assuming frazil is enabled in ocean. This could break some configurations? call allocate_surface_state(sfc_state_in, CS%Grid_in, use_temperature=.true., & do_integrals=.true., omit_frazil=.false., use_iceshelves=.true.) if (CS%rotate_index) then - call rotate_surface_state(sfc_state_in, sfc_state,CS%Grid, CS%turns) + allocate(sfc_state) + call rotate_surface_state(sfc_state_in, sfc_state, CS%Grid, CS%turns) else - sfc_state=>sfc_state_in + sfc_state => sfc_state_in endif endif @@ -2103,14 +2106,14 @@ subroutine initialize_ice_shelf_fluxes(CS, ocn_grid, US, fluxes_in) else call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.") call allocate_forcing_type(CS%Grid_in, fluxes_in, ustar=.true., shelf=.true., & - press=.true., shelf_sfc_accumulation = CS%active_shelf_dynamics, tau_mag=.true.) + press=.true., shelf_sfc_accumulation=CS%active_shelf_dynamics, tau_mag=.true.) endif if (CS%rotate_index) then allocate(fluxes) - call allocate_forcing_type(fluxes_in, CS%Grid, fluxes) + call allocate_forcing_type(fluxes_in, CS%Grid, fluxes, turns=CS%turns) call rotate_forcing(fluxes_in, fluxes, CS%turns) else - fluxes=>fluxes_in + fluxes => fluxes_in endif do j=jsd,jed ; do i=isd,ied @@ -2119,8 +2122,11 @@ subroutine initialize_ice_shelf_fluxes(CS, ocn_grid, US, fluxes_in) if (CS%debug) call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) call add_shelf_pressure(ocn_grid, US, CS, fluxes) - if (CS%rotate_index) & + if (CS%rotate_index) then call rotate_forcing(fluxes, fluxes_in, -CS%turns) + call deallocate_forcing_type(fluxes) + deallocate(fluxes) + endif end subroutine initialize_ice_shelf_fluxes diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index e0bd659a60..76546f834c 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -372,7 +372,7 @@ subroutine DOME_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 64db56b96c..cc4dca16bc 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -331,7 +331,7 @@ subroutine ISOMIP_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 50354b5dc7..7947cc72ed 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -453,9 +453,9 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! The -GV%Rho0 changes the sign convention of the flux and with the scaling factors changes ! the units of the flux from [Conc. m s-1] to [Conc. R Z T-1 ~> Conc. kg m-2 s-1]. call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_11_flux, CFC11_flux, & - scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim) + scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim, turns=G%HI%turns) call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_12_flux, CFC12_flux, & - scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim) + scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim, turns=G%HI%turns) ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. @@ -587,13 +587,13 @@ subroutine OCMIP2_CFC_surface_state(sfc_state, h, G, GV, US, CS) ! These calls load these values into the appropriate arrays in the ! coupler-type structure. call set_coupler_type_data(CFC11_alpha, CS%ind_cfc_11_flux, sfc_state%tr_fields, & - solubility=.true., idim=idim, jdim=jdim) + solubility=.true., idim=idim, jdim=jdim, turns=G%HI%turns) call set_coupler_type_data(CFC11_Csurf, CS%ind_cfc_11_flux, sfc_state%tr_fields, & - idim=idim, jdim=jdim) + idim=idim, jdim=jdim, turns=G%HI%turns) call set_coupler_type_data(CFC12_alpha, CS%ind_cfc_12_flux, sfc_state%tr_fields, & - solubility=.true., idim=idim, jdim=jdim) + solubility=.true., idim=idim, jdim=jdim, turns=G%HI%turns) call set_coupler_type_data(CFC12_Csurf, CS%ind_cfc_12_flux, sfc_state%tr_fields, & - idim=idim, jdim=jdim) + idim=idim, jdim=jdim, turns=G%HI%turns) end subroutine OCMIP2_CFC_surface_state diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index d8eb4d57fb..567c706de0 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -329,7 +329,7 @@ subroutine advection_test_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index b8ed0632a2..0698d7f9cc 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -340,7 +340,7 @@ subroutine boundary_impulse_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index ff2199fc80..2cc4654691 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -395,7 +395,7 @@ subroutine dye_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 4323479823..cd781169af 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -559,7 +559,7 @@ subroutine ideal_age_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 22310b5802..1260711347 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -466,7 +466,7 @@ subroutine oil_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index fa9b978f9c..ff2812b8ee 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -427,7 +427,7 @@ subroutine USER_tracer_surface_state(sfc_state, h, G, GV, CS) ! This call loads the surface values into the appropriate array in the ! coupler-type structure. call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & - idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) enddo endif