Skip to content

Commit

Permalink
More tinkering with OBC_in vs CS%OBC
Browse files Browse the repository at this point in the history
  • Loading branch information
kshedstrom committed Nov 21, 2024
1 parent ba1d178 commit 52605fb
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 28 deletions.
20 changes: 20 additions & 0 deletions src/core/MOM.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2883,6 +2883,26 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
! reservoirs are used.
call open_boundary_register_restarts(HI, GV, US, CS%OBC, CS%tracer_Reg, &
param_file, restart_CSp, use_temperature)
if (turns /= 0) then
if (CS%OBC%radiation_BCs_exist_globally) then
OBC_in%rx_normal => CS%OBC%rx_normal
OBC_in%ry_normal => CS%OBC%ry_normal
endif
if (CS%OBC%oblique_BCs_exist_globally) then
OBC_in%rx_oblique_u => CS%OBC%rx_oblique_u
OBC_in%ry_oblique_u => CS%OBC%ry_oblique_u
OBC_in%rx_oblique_v => CS%OBC%rx_oblique_v
OBC_in%ry_oblique_v => CS%OBC%ry_oblique_v
OBC_in%cff_normal_u => CS%OBC%cff_normal_u
OBC_in%cff_normal_v => CS%OBC%cff_normal_v
endif
if (any(CS%OBC%tracer_x_reservoirs_used)) then
OBC_in%tres_x => CS%OBC%tres_x
endif
if (any(CS%OBC%tracer_y_reservoirs_used)) then
OBC_in%tres_y => CS%OBC%tres_y
endif
endif
endif

if (present(waves_CSp)) then
Expand Down
56 changes: 28 additions & 28 deletions src/core/MOM_open_boundary.F90
Original file line number Diff line number Diff line change
Expand Up @@ -352,24 +352,24 @@ module MOM_open_boundary
type(remapping_CS), pointer :: remap_h_CS=> NULL() !< ALE remapping control structure for
!! thickness-based fields on segments
type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries
real, allocatable :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of
real, pointer :: 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
real, pointer :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of
!! grid points per timestep [nondim]
real, allocatable :: rx_oblique_u(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
real, pointer :: rx_oblique_u(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
!! at u points for restarts [L2 T-2 ~> m2 s-2]
real, allocatable :: ry_oblique_u(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
real, pointer :: ry_oblique_u(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
!! at u points for restarts [L2 T-2 ~> m2 s-2]
real, allocatable :: rx_oblique_v(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
real, pointer :: rx_oblique_v(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
!! at v points for restarts [L2 T-2 ~> m2 s-2]
real, allocatable :: ry_oblique_v(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
real, pointer :: ry_oblique_v(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
!! at v points for restarts [L2 T-2 ~> m2 s-2]
real, allocatable :: cff_normal_u(:,:,:) !< Denominator for normalizing EW oblique boundary condition radiation
real, pointer :: cff_normal_u(:,:,:) !< Denominator for normalizing EW oblique boundary condition radiation
!! rates at u points for restarts [L2 T-2 ~> m2 s-2]
real, allocatable :: cff_normal_v(:,:,:) !< Denominator for normalizing NS oblique boundary condition radiation
real, pointer :: cff_normal_v(:,:,:) !< Denominator for normalizing NS oblique boundary condition radiation
!! rates at v points for restarts [L2 T-2 ~> m2 s-2]
real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
real, pointer :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
real, pointer :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
logical :: debug !< If true, write verbose checksums for debugging purposes.
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 [Z ~> m].
Expand Down Expand Up @@ -1948,15 +1948,15 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS)
call create_group_pass(OBC%pass_oblique, OBC%cff_normal_u, OBC%cff_normal_v, G%Domain, To_All+Scalar_Pair)
call do_group_pass(OBC%pass_oblique, G%Domain)
endif
if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then
if (associated(OBC%tres_x) .and. associated(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 (allocated(OBC%tres_x)) then
elseif (associated(OBC%tres_x)) then
do m=1,OBC%ntr
call pass_var(OBC%tres_x(:,:,:,m), G%Domain, position=EAST_FACE)
enddo
elseif (allocated(OBC%tres_y)) then
elseif (associated(OBC%tres_y)) then
do m=1,OBC%ntr
call pass_var(OBC%tres_y(:,:,:,m), G%Domain, position=NORTH_FACE)
enddo
Expand Down Expand Up @@ -2001,16 +2001,16 @@ subroutine open_boundary_dealloc(OBC)
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_u)) deallocate(OBC%rx_oblique_u)
if (allocated(OBC%ry_oblique_u)) deallocate(OBC%ry_oblique_u)
if (allocated(OBC%rx_oblique_v)) deallocate(OBC%rx_oblique_v)
if (allocated(OBC%ry_oblique_v)) deallocate(OBC%ry_oblique_v)
if (allocated(OBC%cff_normal_u)) deallocate(OBC%cff_normal_u)
if (allocated(OBC%cff_normal_v)) deallocate(OBC%cff_normal_v)
if (allocated(OBC%tres_x)) deallocate(OBC%tres_x)
if (allocated(OBC%tres_y)) deallocate(OBC%tres_y)
if (associated(OBC%rx_normal)) nullify(OBC%rx_normal)
if (associated(OBC%ry_normal)) nullify(OBC%ry_normal)
if (associated(OBC%rx_oblique_u)) nullify(OBC%rx_oblique_u)
if (associated(OBC%ry_oblique_u)) nullify(OBC%ry_oblique_u)
if (associated(OBC%rx_oblique_v)) nullify(OBC%rx_oblique_v)
if (associated(OBC%ry_oblique_v)) nullify(OBC%ry_oblique_v)
if (associated(OBC%cff_normal_u)) nullify(OBC%cff_normal_u)
if (associated(OBC%cff_normal_v)) nullify(OBC%cff_normal_v)
if (associated(OBC%tres_x)) nullify(OBC%tres_x)
if (associated(OBC%tres_y)) nullify(OBC%tres_y)
if (associated(OBC%remap_z_CS)) deallocate(OBC%remap_z_CS)
if (associated(OBC%remap_h_CS)) deallocate(OBC%remap_h_CS)
deallocate(OBC)
Expand Down Expand Up @@ -3369,7 +3369,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
haloshift=0, symmetric=sym, unscale=1.0/US%L_T_to_m_s**2)
endif
if (OBC%ntr == 0) return
if (.not. allocated (OBC%tres_x) .or. .not. allocated (OBC%tres_y)) return
if (.not. associated (OBC%tres_x) .or. .not. associated (OBC%tres_y)) return
do m=1,OBC%ntr
write(var_num,'(I3.3)') m
call uvchksum("radiation_OBCs: OBC%tres_[xy]_"//var_num, OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%HI, &
Expand Down Expand Up @@ -5489,7 +5489,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(I,j,k)+ &
((u_L_out+a_out)*Reg%Tr(ntr_id)%t(I+ishift,j,k) - &
(u_L_in+a_in)*segment%tr_Reg%Tr(m)%t(I,j,k)))
if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
enddo ; endif
enddo
enddo
Expand Down Expand Up @@ -5529,7 +5529,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(i,J,k) + &
((v_L_out+a_out)*Reg%Tr(ntr_id)%t(i,J+jshift,k) - &
(v_L_in+a_in)*segment%tr_Reg%Tr(m)%t(i,J,k)))
if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
if (associated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
enddo ; endif
enddo
enddo
Expand Down Expand Up @@ -5605,7 +5605,7 @@ subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell)

! Update tracer concentrations
segment%tr_Reg%Tr(m)%tres(I,j,:) = tr_column(:)
if (allocated(OBC%tres_x)) then ; do k=1,nz
if (associated(OBC%tres_x)) then ; do k=1,nz
OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
enddo ; endif

Expand Down Expand Up @@ -5672,7 +5672,7 @@ subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell)

! Update tracer concentrations
segment%tr_Reg%Tr(m)%tres(i,J,:) = tr_column(:)
if (allocated(OBC%tres_y)) then ; do k=1,nz
if (associated(OBC%tres_y)) then ; do k=1,nz
OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
enddo ; endif

Expand Down

0 comments on commit 52605fb

Please sign in to comment.