diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index f49ce0073b..32eb036a94 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3039,7 +3039,7 @@ end subroutine apply_velocity_OBCs !! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, & integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), intent(inout) :: OBC !< An associated pointer to an OBC type. + type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ed885b9574..581cd5e68e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -75,26 +75,26 @@ module MOM_open_boundary !> Open boundary segment data from files (mostly). type, public :: OBC_segment_data_type - integer :: fid !< handle from FMS associated with segment data on disk - integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk - character(len=8) :: name !< a name identifier for the segment data - real, dimension(:,:,:), allocatable :: buffer_src !< buffer for segment data located at cell faces - !! and on the original vertical grid - integer :: nk_src !< Number of vertical levels in the source data - real, dimension(:,:,:), allocatable :: dz_src !< vertical grid cell spacing of the incoming segment - !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] - real, dimension(:,:,:), pointer :: buffer_dst=>NULL() !< buffer src data remapped to the target vertical grid + integer :: fid !< handle from FMS associated with segment data on disk + integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk + character(len=8) :: name !< a name identifier for the segment data + real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces + !! and on the original vertical grid + integer :: nk_src !< Number of vertical levels in the source data + real, allocatable :: dz_src(:,:,:) !< vertical grid cell spacing of the incoming segment + !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] + real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. type, public :: OBC_segment_tracer_type - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array - real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows - character(len=32) :: name !< tracer name used for error messages - type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer - real, dimension(:,:,:), pointer :: tres => NULL() !< tracer reservoir array - logical :: is_initialized !< reservoir values have been set when True + real, allocatable :: t(:,:,:) !< tracer concentration array + real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows + character(len=32) :: name !< tracer name used for error messages + type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer + real, allocatable :: tres(:,:,:) !< tracer reservoir array + logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type !> Registry type for tracers on segments @@ -145,9 +145,8 @@ module MOM_open_boundary logical :: is_N_or_S !< True if the OB is facing North or South and exists on this PE. logical :: is_E_or_W !< True if the OB is facing East or West and exists on this PE. logical :: is_E_or_W_2 !< True if the OB is facing East or West anywhere. - type(OBC_segment_data_type), pointer, dimension(:) :: field=>NULL() !< OBC data + type(OBC_segment_data_type), pointer :: field(:) => NULL() !< OBC data integer :: num_fields !< number of OBC data fields (e.g. u_normal,u_parallel and eta for Flather) - character(len=32), pointer, dimension(:) :: field_names=>NULL() !< field names for this segment integer :: Is_obc !< i-indices of boundary segment. integer :: Ie_obc !< i-indices of boundary segment. integer :: Js_obc !< j-indices of boundary segment. @@ -163,44 +162,44 @@ module MOM_open_boundary logical :: on_pe !< true if any portion of the segment is located in this PE's data domain logical :: temp_segment_data_exists !< true if temperature data arrays are present logical :: salt_segment_data_exists !< true if salinity data arrays are present - real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [L T-1 ~> m s-1] - !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [T-1 ~> s-1]. - real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [H L2 T-1 ~> m3 s-1]. - real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the - !! segment [H ~> m or kg m-2]. - real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along - !! the segment times the grid spacing [T-1 ~> s-1] - real, pointer, dimension(:,:,:) :: rx_norm_rad=>NULL() !< The previous normal phase speed use for EW radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: ry_norm_rad=>NULL() !< The previous normal phase speed use for NS radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: rx_norm_obl=>NULL() !< The previous normal radiation coefficient for EW - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: ry_norm_obl=>NULL() !< The previous normal radiation coefficient for NS - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation - !! for normal velocity [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [T-1 ~> s-1]. + real, allocatable :: Cg(:,:) !< The external gravity wave speed [L T-1 ~> m s-1] + !! at OBC-points. + real, allocatable :: Htot(:,:) !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: h(:,:,:) !< The cell thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: normal_vel(:,:,:) !< The layer velocity normal to the OB + !! segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_vel(:,:,:) !< The layer velocity tangential to the + !! OB segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_grad(:,:,:) !< The gradient of the velocity tangential + !! to the OB segment [T-1 ~> s-1]. + real, allocatable :: normal_trans(:,:,:) !< The layer transport normal to the OB + !! segment [H L2 T-1 ~> m3 s-1]. + real, allocatable :: normal_vel_bt(:,:) !< The barotropic velocity normal to + !! the OB segment [L T-1 ~> m s-1]. + real, allocatable :: eta(:,:) !< The sea-surface elevation along the + !! segment [H ~> m or kg m-2]. + real, allocatable :: grad_normal(:,:,:) !< The gradient of the normal flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_tan(:,:,:) !< The gradient of the tangential flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_gradient(:,:,:) !< The gradient of the gradient of tangential flow along + !! the segment times the grid spacing [T-1 ~> s-1] + real, allocatable :: rx_norm_rad(:,:,:) !< The previous normal phase speed use for EW radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: ry_norm_rad(:,:,:) !< The previous normal phase speed use for NS radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: rx_norm_obl(:,:,:) !< The previous normal radiation coefficient for EW + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_norm_obl(:,:,:) !< The previous normal radiation coefficient for NS + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< The denominator for oblique radiation + !! for normal velocity [L2 T-2 ~> m2 s-2] + real, allocatable :: nudged_normal_vel(:,:,:) !< The layer velocity normal to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_vel(:,:,:) !< The layer velocity tangential to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_grad(:,:,:) !< The layer dvdx or dudy towards which nudging + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale_out !< An effective inverse length scale for restoring @@ -256,11 +255,9 @@ module MOM_open_boundary logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. - logical, pointer, dimension(:) :: & - tracer_x_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_x_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with x reservoirs (needed for restarts). - logical, pointer, dimension(:) :: & - tracer_y_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_y_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with y reservoirs (needed for restarts). integer :: ntr = 0 !< number of tracers integer :: n_tide_constituents = 0 !< Number of tidal constituents to add to the boundary. @@ -278,12 +275,10 @@ module MOM_open_boundary type(time_type) :: time_ref !< Reference date (t = 0) for tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Lunar and solar longitudes used to calculate tidal forcing. ! Properties of the segments used. - type(OBC_segment_type), pointer, dimension(:) :: & - segment => NULL() !< List of segment objects. + type(OBC_segment_type), allocatable :: segment(:) !< List of segment objects. ! Which segment object describes the current point. - integer, pointer, dimension(:,:) :: & - segnum_u => NULL(), & !< Segment number of u-points. - segnum_v => NULL() !< Segment number of v-points. + integer, allocatable :: segnum_u(:,:) !< Segment number of u-points. + integer, allocatable :: segnum_v(:,:) !< Segment number of v-points. ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation @@ -295,17 +290,15 @@ module MOM_open_boundary logical :: OBC_pe !< Is there an open boundary on this tile? type(remapping_CS), pointer :: remap_CS=> NULL() !< ALE remapping control structure for segments only type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries - real, pointer, dimension(:,:,:) :: & - rx_normal => NULL(), & !< Array storage for normal phase speed for EW radiation OBCs in units of - !! grid points per timestep [nondim] - ry_normal => NULL(), & !< Array storage for normal phase speed for NS radiation OBCs in units of - !! grid points per timestep [nondim] - rx_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - ry_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - cff_normal => NULL() !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:,:) :: & - tres_x => NULL(), & !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] - tres_y => NULL() !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: rx_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] real :: silly_h !< A silly value of thickness outside of the domain that can be used to test !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test @@ -651,9 +644,9 @@ end subroutine open_boundary_config !> Allocate space for reading OBC data from files. It sets up the required vertical !! remapping. In the process, it does funky stuff with the MPI processes. subroutine initialize_segment_data(G, OBC, PF) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle integer :: n, m, num_fields character(len=1024) :: segstr @@ -688,7 +681,6 @@ subroutine initialize_segment_data(G, OBC, PF) ! Try this here just for the documentation. It is repeated below. do n=1, OBC%number_of_segments - segment => OBC%segment(n) write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n call get_param(PF, mdl, segnam, segstr, 'OBC segment docs') enddo @@ -958,14 +950,14 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data subroutine initialize_obc_tides(OBC, param_file) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing (year, month, day). integer, dimension(3) :: nodal_ref_date !< Date to calculate nodal modulation for (year, month, day). character(len=50) :: tide_constituent_str !< List of tidal constituents to include on boundary. - type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing - type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. - integer :: c !< Index to tidal constituent. + type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing + type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. + integer :: c !< Index to tidal constituent. call get_param(param_file, mdl, "OBC_TIDE_CONSTITUENTS", tide_constituent_str, & "Names of tidal constituents being added to the open boundaries.", & @@ -1175,7 +1167,7 @@ end subroutine setup_segment_indices !> Parse an OBC_SEGMENT_%%% string starting with "I=" and configure placement and type of OBC accordingly subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" @@ -1315,7 +1307,7 @@ end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" @@ -1638,8 +1630,8 @@ end subroutine parse_segment_data_str !> Parse all the OBC_SEGMENT_%%%_DATA strings again !! to see which need tracer reservoirs (all pes need to know). subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables @@ -1809,16 +1801,16 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) To_All+Scalar_Pair) if (OBC%oblique_BCs_exist_globally) call pass_vector(OBC%rx_oblique, OBC%ry_oblique, G%Domain, & To_All+Scalar_Pair) - if (associated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) - if (associated(OBC%tres_x) .and. associated(OBC%tres_y)) then + if (allocated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) + if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_vector(OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%Domain, To_All+Scalar_Pair) enddo - elseif (associated(OBC%tres_x)) then + elseif (allocated(OBC%tres_x)) then do m=1,OBC%ntr call pass_var(OBC%tres_x(:,:,:,m), G%Domain, position=EAST_FACE) enddo - elseif (associated(OBC%tres_y)) then + elseif (allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_var(OBC%tres_y(:,:,:,m), G%Domain, position=NORTH_FACE) enddo @@ -1897,18 +1889,18 @@ subroutine open_boundary_dealloc(OBC) do n=1, OBC%number_of_segments segment => OBC%segment(n) - call deallocate_OBC_segment_data(OBC, segment) + call deallocate_OBC_segment_data(segment) enddo - if (associated(OBC%segment)) deallocate(OBC%segment) - if (associated(OBC%segnum_u)) deallocate(OBC%segnum_u) - if (associated(OBC%segnum_v)) deallocate(OBC%segnum_v) - if (associated(OBC%rx_normal)) deallocate(OBC%rx_normal) - if (associated(OBC%ry_normal)) deallocate(OBC%ry_normal) - if (associated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) - if (associated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) - if (associated(OBC%cff_normal)) deallocate(OBC%cff_normal) - if (associated(OBC%tres_x)) deallocate(OBC%tres_x) - if (associated(OBC%tres_y)) deallocate(OBC%tres_y) + if (allocated(OBC%segment)) deallocate(OBC%segment) + if (allocated(OBC%segnum_u)) deallocate(OBC%segnum_u) + if (allocated(OBC%segnum_v)) deallocate(OBC%segnum_v) + if (allocated(OBC%rx_normal)) deallocate(OBC%rx_normal) + if (allocated(OBC%ry_normal)) deallocate(OBC%ry_normal) + if (allocated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) + if (allocated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) + if (allocated(OBC%cff_normal)) deallocate(OBC%cff_normal) + if (allocated(OBC%tres_x)) deallocate(OBC%tres_x) + if (allocated(OBC%tres_y)) deallocate(OBC%tres_y) deallocate(OBC) end subroutine open_boundary_dealloc @@ -2077,8 +2069,8 @@ end subroutine open_boundary_impose_land_mask subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - ! Local variables + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, m, n @@ -2088,7 +2080,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%t(i,j,k) @@ -2099,7 +2091,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%t(i,J,k) @@ -2209,7 +2201,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed segment%tr_Reg%Tr(m)%tres(I,j,k) = OBC%tres_x(I,j,k,m) @@ -2220,7 +2212,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied segment%tr_Reg%Tr(m)%tres(i,J,k) = OBC%tres_y(i,J,k,m) @@ -3298,7 +3290,7 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, GV, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(OBC_segment_type), pointer :: segment !< OBC segment structure + type(OBC_segment_type), intent(inout) :: segment !< OBC segment structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k @@ -3420,15 +3412,14 @@ end subroutine gradient_at_q_points !> Sets the initial values of the tracer open boundary conditions. !! Redoing this elsewhere. -subroutine set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure +subroutine set_tracer_data(OBC, tv, h, G, GV, PF) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness - type(param_file_type), intent(in) :: PF !< Parameter file handle - type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry - ! Local variables + type(ocean_OBC_type), target, intent(in) :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness + type(param_file_type), intent(in) :: PF !< Parameter file handle + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n integer :: isd_off, jsd_off integer :: IsdB, IedB, JsdB, JedB @@ -3484,7 +3475,7 @@ end subroutine set_tracer_data !> Needs documentation function lookup_seg_field(OBC_seg,field) - type(OBC_segment_type), pointer :: OBC_seg !< OBC segment + type(OBC_segment_type), intent(in) :: OBC_seg !< OBC segment character(len=32), intent(in) :: field !< The field name integer :: lookup_seg_field ! Local variables @@ -3503,7 +3494,7 @@ end function lookup_seg_field !> Allocate segment data fields subroutine allocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(in) :: OBC !< Open boundary structure type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables integer :: isd, ied, jsd, jed @@ -3593,35 +3584,35 @@ subroutine allocate_OBC_segment_data(OBC, segment) end subroutine allocate_OBC_segment_data !> Deallocate segment data fields -subroutine deallocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure +subroutine deallocate_OBC_segment_data(segment) type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables character(len=40) :: mdl = "deallocate_OBC_segment_data" ! This subroutine's name. if (.not. segment%on_pe) return - if (associated (segment%Cg)) deallocate(segment%Cg) - if (associated (segment%Htot)) deallocate(segment%Htot) - if (associated (segment%h)) deallocate(segment%h) - if (associated (segment%eta)) deallocate(segment%eta) - if (associated (segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) - if (associated (segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) - if (associated (segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) - if (associated (segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) - if (associated (segment%cff_normal)) deallocate(segment%cff_normal) - if (associated (segment%grad_normal)) deallocate(segment%grad_normal) - if (associated (segment%grad_tan)) deallocate(segment%grad_tan) - if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) - if (associated (segment%normal_vel)) deallocate(segment%normal_vel) - if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) - if (associated (segment%normal_trans)) deallocate(segment%normal_trans) - if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) - if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) - if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) - if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) - if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) - if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) + if (allocated(segment%Cg)) deallocate(segment%Cg) + if (allocated(segment%Htot)) deallocate(segment%Htot) + if (allocated(segment%h)) deallocate(segment%h) + if (allocated(segment%eta)) deallocate(segment%eta) + if (allocated(segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) + if (allocated(segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) + if (allocated(segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) + if (allocated(segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) + if (allocated(segment%cff_normal)) deallocate(segment%cff_normal) + if (allocated(segment%grad_normal)) deallocate(segment%grad_normal) + if (allocated(segment%grad_tan)) deallocate(segment%grad_tan) + if (allocated(segment%grad_gradient)) deallocate(segment%grad_gradient) + if (allocated(segment%normal_vel)) deallocate(segment%normal_vel) + if (allocated(segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) + if (allocated(segment%normal_trans)) deallocate(segment%normal_trans) + if (allocated(segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) + if (allocated(segment%tangential_vel)) deallocate(segment%tangential_vel) + if (allocated(segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (allocated(segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) + if (allocated(segment%tangential_grad)) deallocate(segment%tangential_grad) + + if (associated(segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) end subroutine deallocate_OBC_segment_data @@ -3738,14 +3729,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) integer :: i2, j2 ! indices for referencing local domain array integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain integer :: ishift, jshift ! offsets for staggered locations - real, dimension(:,:), pointer :: seg_vel => NULL() ! pointer to segment velocity array - real, dimension(:,:), pointer :: seg_trans => NULL() ! pointer to segment transport array real, dimension(:,:,:), allocatable, target :: tmp_buffer real, dimension(:), allocatable :: h_stack integer :: is_obc2, js_obc2 real :: net_H_src, net_H_int, scl_fac real :: tidal_vel, tidal_elev - real, pointer, dimension(:,:) :: normal_trans_bt=>NULL() ! barotropic transport + real, allocatable :: normal_trans_bt(:,:) ! barotropic transport integer :: turns ! Number of index quarter turns real :: time_delta ! Time since tidal reference date @@ -3816,7 +3805,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) siz(1)=size(segment%field(m)%buffer_src,1) siz(2)=size(segment%field(m)%buffer_src,2) siz(3)=size(segment%field(m)%buffer_src,3) - if (.not.associated(segment%field(m)%buffer_dst)) then + if (.not.allocated(segment%field(m)%buffer_dst)) then if (siz(3) /= segment%field(m)%nk_src) call MOM_error(FATAL,'nk_src inconsistency') if (segment%field(m)%nk_src > 1) then if (segment%is_E_or_W) then @@ -4113,7 +4102,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (turns /= 0) & deallocate(tmp_buffer_in) else ! fid <= 0 (Uniform value) - if (.not. associated(segment%field(m)%buffer_dst)) then + if (.not. allocated(segment%field(m)%buffer_dst)) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) @@ -4178,7 +4167,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) & / (max(segment%Htot(I,j), 1.e-12 * GV%m_to_H) * G%dyCu(I,j)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then J=js_obc @@ -4200,10 +4189,10 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) & / (max(segment%Htot(i,J), 1.e-12 * GV%m_to_H) * G%dxCv(i,J)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then I=is_obc do J=js_obc,je_obc tidal_vel = 0.0 @@ -4217,11 +4206,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then J=js_obc do I=is_obc,ie_obc tidal_vel = 0.0 @@ -4235,27 +4224,27 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo endif elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then I=is_obc do J=js_obc,je_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then J=js_obc do I=is_obc,ie_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo @@ -4314,7 +4303,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif if (trim(segment%field(m)%name) == 'TEMP') then - if (associated(segment%field(m)%buffer_dst)) then + if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4329,7 +4318,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%tr_Reg%Tr(1)%OBC_inflow_conc = segment%field(m)%value endif elseif (trim(segment%field(m)%name) == 'SALT') then - if (associated(segment%field(m)%buffer_dst)) then + if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4358,7 +4347,7 @@ end subroutine update_OBC_segment_data !! value of Time as the beginning of the ramp period. subroutine update_OBC_ramp(Time, OBC, activate) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure logical, optional, intent(in) :: activate !< Specifiy whether to record the value of !! Time as the beginning of the ramp period @@ -4582,7 +4571,7 @@ subroutine segment_tracer_registry_end(Reg) if (associated(Reg)) then do n = 1, Reg%ntseg - if (associated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) + if (allocated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) enddo deallocate(Reg) endif @@ -4623,12 +4612,11 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments subroutine fill_temp_salt_segments(G, GV, OBC, tv) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure -! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz integer :: i, j, k type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -4946,15 +4934,6 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart call MOM_error(FATAL, "open_boundary_register_restarts: Called with "//& "uninitialized OBC control structure") - if (associated(OBC%rx_normal) .or. associated(OBC%ry_normal) .or. & - associated(OBC%rx_oblique) .or. associated(OBC%ry_oblique) .or. associated(OBC%cff_normal)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - - if (associated(OBC%tres_x) .or. associated(OBC%tres_y)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - ! *** This is a temporary work around for restarts with OBC segments. ! This implementation uses 3D arrays solely for restarts. We need ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using @@ -4984,7 +4963,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart endif if (Reg%ntr == 0) return - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then OBC%ntr = Reg%ntr allocate(OBC%tracer_x_reservoirs_used(Reg%ntr), source=.false.) allocate(OBC%tracer_y_reservoirs_used(Reg%ntr), source=.false.) @@ -5046,7 +5025,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, intent(in) :: dt !< time increment [T ~> s] type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - ! Local variables + type(OBC_segment_type), pointer :: segment=>NULL() real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell [L ~> m] @@ -5072,7 +5051,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & @@ -5081,7 +5060,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) - if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) + if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif ; enddo enddo elseif (segment%is_N_or_S) then @@ -5097,7 +5076,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & @@ -5106,7 +5085,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) - if (associated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) + if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) enddo ; endif ; enddo enddo endif @@ -5123,12 +5102,12 @@ end subroutine update_segment_tracer_reservoirs !! @remark{There is a (hard-wired) "tolerance" parameter such that the !! criteria for adjustment must equal or exceed 10cm.} subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) - 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(OBC_segment_type), intent(inout) :: segment !< pointer to segment type - integer, intent(in) :: fld !< field index to adjust thickness - ! Local variables + 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(OBC_segment_type), intent(inout) :: segment !< OBC segment + integer, intent(in) :: fld !< field index to adjust thickness + integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] @@ -5434,7 +5413,7 @@ end subroutine rotate_OBC_segment_config !> Initialize the segments and field-related data of a rotated OBC. subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) - type(ocean_OBC_type), pointer, intent(in) :: OBC_in !< OBC on input map + type(ocean_OBC_type), intent(in) :: OBC_in !< OBC on input map type(ocean_grid_type), intent(in) :: G !< Rotated grid metric type(verticalGrid_type), intent(in) :: GV !< Vertical grid type(unit_scale_type), intent(in) :: US !< Unit scaling @@ -5523,7 +5502,6 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns) segment%field(n)%dz_src) endif - segment%field(n)%buffer_dst => NULL() segment%field(n)%value = segment_in%field(n)%value enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 37acb8ca42..dfcd097be0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -630,7 +630,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "OBC_USER_CONFIG = "//trim(config)//" have not been fully implemented.") endif if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) + call set_tracer_data(OBC, tv, h, G, GV, PF) endif endif ! if (open_boundary_query(OBC, apply_nudged_OBC=.true.)) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index be4c059982..34c8dddf04 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -450,7 +450,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then I = segment%HI%IsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_W) then T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -594,7 +594,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = uhr(I,j,k) ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else ; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -617,7 +617,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then uhh(I) = uhr(I,j,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif enddo @@ -821,7 +821,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (i>=segment%HI%isd .and. i<=segment%HI%ied) then J = segment%HI%JsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_S) then T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -966,7 +966,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -989,7 +989,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 8599272e32..ee4491799a 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -256,7 +256,7 @@ subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) ! Store this information for use in setting up the OBC restarts for tracer reservoirs. OBC%ntr = tr_Reg%ntr - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then allocate(OBC%tracer_x_reservoirs_used(OBC%ntr)) allocate(OBC%tracer_y_reservoirs_used(OBC%ntr)) OBC%tracer_x_reservoirs_used(:) = .false. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index fe5168ab7e..9bdf9b45c3 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -287,7 +287,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB+1,JedB-1 ; do I=IsdB,IedB x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J) @@ -343,7 +343,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB,JedB ; do I=IsdB+1,IedB-1 x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J)