Skip to content

Commit 5a593e9

Browse files
kshedstromkshedstrom
committed
Try again at fix_obc_maskingdepth patch
 - "git rebase" made a conflicted mess
1 parent 8f8893f commit 5a593e9

File tree

2 files changed

+120
-34
lines changed

2 files changed

+120
-34
lines changed

‎src/core/MOM.F90‎

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@ module MOM
113113
use MOM_open_boundary, only : ocean_OBC_type, OBC_registry_type
114114
use MOM_open_boundary, only : register_temp_salt_segments, update_segment_tracer_reservoirs
115115
use MOM_open_boundary, only : open_boundary_register_restarts, remap_OBC_fields
116-
use MOM_open_boundary, only : open_boundary_setup_vert
116+
use MOM_open_boundary, only : open_boundary_setup_vert, update_OBC_segment_data
117117
use MOM_open_boundary, only : rotate_OBC_config, rotate_OBC_init
118118
use MOM_porous_barriers, only : porous_widths_layer, porous_widths_interface, porous_barriers_init
119119
use MOM_porous_barriers, only : porous_barrier_CS
@@ -3056,6 +3056,26 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
30563056
! reservoirs are used.
30573057
call open_boundary_register_restarts(HI, GV, US, CS%OBC, CS%tracer_Reg, &
30583058
param_file, restart_CSp, use_temperature)
3059+
if (turns /= 0) then
3060+
if (CS%OBC%radiation_BCs_exist_globally) then
3061+
OBC_in%rx_normal => CS%OBC%rx_normal
3062+
OBC_in%ry_normal => CS%OBC%ry_normal
3063+
endif
3064+
if (CS%OBC%oblique_BCs_exist_globally) then
3065+
OBC_in%rx_oblique_u => CS%OBC%rx_oblique_u
3066+
OBC_in%ry_oblique_u => CS%OBC%ry_oblique_u
3067+
OBC_in%rx_oblique_v => CS%OBC%rx_oblique_v
3068+
OBC_in%ry_oblique_v => CS%OBC%ry_oblique_v
3069+
OBC_in%cff_normal_u => CS%OBC%cff_normal_u
3070+
OBC_in%cff_normal_v => CS%OBC%cff_normal_v
3071+
endif
3072+
if (any(CS%OBC%tracer_x_reservoirs_used)) then
3073+
OBC_in%tres_x => CS%OBC%tres_x
3074+
endif
3075+
if (any(CS%OBC%tracer_y_reservoirs_used)) then
3076+
OBC_in%tres_y => CS%OBC%tres_y
3077+
endif
3078+
endif
30593079
endif
30603080

30613081
if (present(waves_CSp)) then
@@ -3178,8 +3198,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
31783198
call update_ALE_sponge_field(CS%ALE_sponge_CSp, S_in, G, GV, CS%S)
31793199
endif
31803200

3181-
if (associated(OBC_in)) &
3201+
if (associated(OBC_in)) then
31823202
call rotate_OBC_init(OBC_in, G, GV, US, param_file, CS%tv, restart_CSp, CS%OBC)
3203+
if (CS%OBC%some_need_no_IO_for_data) then
3204+
call calc_derived_thermo(CS%tv, CS%h, G, GV, US)
3205+
call update_OBC_segment_data(G, GV, US, CS%OBC, CS%tv, CS%h, Time)
3206+
endif
3207+
endif
31833208

31843209
deallocate(u_in)
31853210
deallocate(v_in)

‎src/core/MOM_open_boundary.F90‎

Lines changed: 93 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -353,25 +353,27 @@ module MOM_open_boundary
353353
type(remapping_CS), pointer :: remap_h_CS=> NULL() !< ALE remapping control structure for
354354
!! thickness-based fields on segments
355355
type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries
356-
real, allocatable :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of
356+
real, pointer :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of
357357
!! grid points per timestep [nondim]
358-
real, allocatable :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of
358+
real, pointer :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of
359359
!! grid points per timestep [nondim]
360-
real, allocatable :: rx_oblique_u(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
360+
real, pointer :: rx_oblique_u(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
361361
!! at u points for restarts [L2 T-2 ~> m2 s-2]
362-
real, allocatable :: ry_oblique_u(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
362+
real, pointer :: ry_oblique_u(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
363363
!! at u points for restarts [L2 T-2 ~> m2 s-2]
364-
real, allocatable :: rx_oblique_v(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
364+
real, pointer :: rx_oblique_v(:,:,:) !< X-direction oblique boundary condition radiation speeds squared
365365
!! at v points for restarts [L2 T-2 ~> m2 s-2]
366-
real, allocatable :: ry_oblique_v(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
366+
real, pointer :: ry_oblique_v(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared
367367
!! at v points for restarts [L2 T-2 ~> m2 s-2]
368-
real, allocatable :: cff_normal_u(:,:,:) !< Denominator for normalizing EW oblique boundary condition radiation
368+
real, pointer :: cff_normal_u(:,:,:) !< Denominator for normalizing EW oblique boundary condition radiation
369369
!! rates at u points for restarts [L2 T-2 ~> m2 s-2]
370-
real, allocatable :: cff_normal_v(:,:,:) !< Denominator for normalizing NS oblique boundary condition radiation
370+
real, pointer :: cff_normal_v(:,:,:) !< Denominator for normalizing NS oblique boundary condition radiation
371371
!! rates at v points for restarts [L2 T-2 ~> m2 s-2]
372-
real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
373-
real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
374-
logical :: debug !< If true, write verbose checksums for debugging purposes.
372+
real, pointer :: tres_x(:,:,:,:) => Null() !< Array storage of tracer reservoirs for restarts,
373+
!! in unscaled units [conc]
374+
real, pointer :: tres_y(:,:,:,:) => Null() !< Array storage of tracer reservoirs for restarts,
375+
!! in unscaled units [conc]
376+
logical :: debug !< If true, write verbose checksums for debugging purposes.
375377
real :: silly_h !< A silly value of thickness outside of the domain that can be used to test
376378
!! the independence of the OBCs to this external data [Z ~> m].
377379
real :: silly_u !< A silly value of velocity outside of the domain that can be used to test
@@ -1963,15 +1965,15 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS)
19631965
call create_group_pass(OBC%pass_oblique, OBC%cff_normal_u, OBC%cff_normal_v, G%Domain, To_All+Scalar_Pair)
19641966
call do_group_pass(OBC%pass_oblique, G%Domain)
19651967
endif
1966-
if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then
1968+
if (associated(OBC%tres_x) .and. associated(OBC%tres_y)) then
19671969
do m=1,OBC%ntr
19681970
call pass_vector(OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%Domain, To_All+Scalar_Pair)
19691971
enddo
1970-
elseif (allocated(OBC%tres_x)) then
1972+
elseif (associated(OBC%tres_x)) then
19711973
do m=1,OBC%ntr
19721974
call pass_var(OBC%tres_x(:,:,:,m), G%Domain, position=EAST_FACE)
19731975
enddo
1974-
elseif (allocated(OBC%tres_y)) then
1976+
elseif (associated(OBC%tres_y)) then
19751977
do m=1,OBC%ntr
19761978
call pass_var(OBC%tres_y(:,:,:,m), G%Domain, position=NORTH_FACE)
19771979
enddo
@@ -2016,16 +2018,16 @@ subroutine open_boundary_dealloc(OBC)
20162018
if (allocated(OBC%segment)) deallocate(OBC%segment)
20172019
if (allocated(OBC%segnum_u)) deallocate(OBC%segnum_u)
20182020
if (allocated(OBC%segnum_v)) deallocate(OBC%segnum_v)
2019-
if (allocated(OBC%rx_normal)) deallocate(OBC%rx_normal)
2020-
if (allocated(OBC%ry_normal)) deallocate(OBC%ry_normal)
2021-
if (allocated(OBC%rx_oblique_u)) deallocate(OBC%rx_oblique_u)
2022-
if (allocated(OBC%ry_oblique_u)) deallocate(OBC%ry_oblique_u)
2023-
if (allocated(OBC%rx_oblique_v)) deallocate(OBC%rx_oblique_v)
2024-
if (allocated(OBC%ry_oblique_v)) deallocate(OBC%ry_oblique_v)
2025-
if (allocated(OBC%cff_normal_u)) deallocate(OBC%cff_normal_u)
2026-
if (allocated(OBC%cff_normal_v)) deallocate(OBC%cff_normal_v)
2027-
if (allocated(OBC%tres_x)) deallocate(OBC%tres_x)
2028-
if (allocated(OBC%tres_y)) deallocate(OBC%tres_y)
2021+
if (associated(OBC%rx_normal)) nullify(OBC%rx_normal)
2022+
if (associated(OBC%ry_normal)) nullify(OBC%ry_normal)
2023+
if (associated(OBC%rx_oblique_u)) nullify(OBC%rx_oblique_u)
2024+
if (associated(OBC%ry_oblique_u)) nullify(OBC%ry_oblique_u)
2025+
if (associated(OBC%rx_oblique_v)) nullify(OBC%rx_oblique_v)
2026+
if (associated(OBC%ry_oblique_v)) nullify(OBC%ry_oblique_v)
2027+
if (associated(OBC%cff_normal_u)) nullify(OBC%cff_normal_u)
2028+
if (associated(OBC%cff_normal_v)) nullify(OBC%cff_normal_v)
2029+
if (associated(OBC%tres_x)) nullify(OBC%tres_x)
2030+
if (associated(OBC%tres_y)) nullify(OBC%tres_y)
20292031
if (associated(OBC%remap_z_CS)) deallocate(OBC%remap_z_CS)
20302032
if (associated(OBC%remap_h_CS)) deallocate(OBC%remap_h_CS)
20312033
deallocate(OBC)
@@ -3384,7 +3386,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
33843386
haloshift=0, symmetric=sym, unscale=1.0/US%L_T_to_m_s**2)
33853387
endif
33863388
if (OBC%ntr == 0) return
3387-
if (.not. allocated (OBC%tres_x) .or. .not. allocated (OBC%tres_y)) return
3389+
if (.not. associated (OBC%tres_x) .or. .not. associated (OBC%tres_y)) return
33883390
do m=1,OBC%ntr
33893391
write(var_num,'(I3.3)') m
33903392
call uvchksum("radiation_OBCs: OBC%tres_[xy]_"//var_num, OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%HI, &
@@ -5504,7 +5506,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
55045506
((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(I,j,k)+ &
55055507
((u_L_out+a_out)*Reg%Tr(ntr_id)%t(I+ishift,j,k) - &
55065508
(u_L_in+a_in)*segment%tr_Reg%Tr(m)%t(I,j,k)))
5507-
if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
5509+
if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
55085510
enddo ; endif
55095511
enddo
55105512
enddo
@@ -5544,7 +5546,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
55445546
((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(i,J,k) + &
55455547
((v_L_out+a_out)*Reg%Tr(ntr_id)%t(i,J+jshift,k) - &
55465548
(v_L_in+a_in)*segment%tr_Reg%Tr(m)%t(i,J,k)))
5547-
if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
5549+
if (associated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
55485550
enddo ; endif
55495551
enddo
55505552
enddo
@@ -5620,7 +5622,7 @@ subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell)
56205622

56215623
! Update tracer concentrations
56225624
segment%tr_Reg%Tr(m)%tres(I,j,:) = tr_column(:)
5623-
if (allocated(OBC%tres_x)) then ; do k=1,nz
5625+
if (associated(OBC%tres_x)) then ; do k=1,nz
56245626
OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
56255627
enddo ; endif
56265628

@@ -5687,7 +5689,7 @@ subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell)
56875689

56885690
! Update tracer concentrations
56895691
segment%tr_Reg%Tr(m)%tres(i,J,:) = tr_column(:)
5690-
if (allocated(OBC%tres_y)) then ; do k=1,nz
5692+
if (associated(OBC%tres_y)) then ; do k=1,nz
56915693
OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
56925694
enddo ; endif
56935695

@@ -6070,13 +6072,13 @@ subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC)
60706072
"If true, Temperature and salinity are used as state "//&
60716073
"variables.", default=.true., do_not_log=.true.)
60726074

6075+
if (use_temperature) &
6076+
call fill_temp_salt_segments(G, GV, US, OBC, tv)
6077+
60736078
do l = 1, OBC%number_of_segments
60746079
call rotate_OBC_segment_data(OBC_in%segment(l), OBC%segment(l), G%HI%turns)
60756080
enddo
60766081

6077-
if (use_temperature) &
6078-
call fill_temp_salt_segments(G, GV, US, OBC, tv)
6079-
60806082
call open_boundary_init(G, GV, US, param_file, OBC, restart_CS)
60816083
end subroutine rotate_OBC_init
60826084

@@ -6099,6 +6101,14 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns)
60996101
segment%field(n)%handle = segment_in%field(n)%handle
61006102
segment%field(n)%dz_handle = segment_in%field(n)%dz_handle
61016103

6104+
if (allocated(segment_in%field(n)%buffer_dst)) then
6105+
call allocate_rotated_array(segment_in%field(n)%buffer_dst, &
6106+
lbound(segment_in%field(n)%buffer_dst), turns, &
6107+
segment%field(n)%buffer_dst)
6108+
call rotate_array(segment_in%field(n)%buffer_dst, turns, &
6109+
segment%field(n)%buffer_dst)
6110+
endif
6111+
61026112
if (modulo(turns, 2) /= 0) then
61036113
select case (segment_in%field(n)%name)
61046114
case ('U')
@@ -6109,6 +6119,7 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns)
61096119
segment%field(n)%name = 'Vphase'
61106120
case ('V')
61116121
segment%field(n)%name = 'U'
6122+
segment%field(n)%buffer_dst(:,:,:) = -segment%field(n)%buffer_dst(:,:,:)
61126123
case ('Vamp')
61136124
segment%field(n)%name = 'Uamp'
61146125
case ('Vphase')
@@ -6145,6 +6156,56 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns)
61456156
segment%field(n)%value = segment_in%field(n)%value
61466157
enddo
61476158

6159+
if (allocated(segment_in%SSH)) &
6160+
call rotate_array(segment_in%SSH, turns, segment%SSH)
6161+
if (allocated(segment_in%cg)) &
6162+
call rotate_array(segment_in%cg, turns, segment%cg)
6163+
if (allocated(segment_in%htot)) &
6164+
call rotate_array(segment_in%htot, turns, segment%htot)
6165+
if (allocated(segment_in%dztot)) &
6166+
call rotate_array(segment_in%dztot, turns, segment%dztot)
6167+
if (allocated(segment_in%h)) &
6168+
call rotate_array(segment_in%h, turns, segment%h)
6169+
if (allocated(segment_in%normal_vel)) &
6170+
call rotate_array(segment_in%normal_vel, turns, segment%normal_vel)
6171+
if (allocated(segment_in%normal_trans)) &
6172+
call rotate_array(segment_in%normal_trans, turns, segment%normal_trans)
6173+
if (allocated(segment_in%normal_vel_bt)) &
6174+
call rotate_array(segment_in%normal_vel_bt, turns, segment%normal_vel_bt)
6175+
if (allocated(segment_in%tangential_vel)) &
6176+
call rotate_array(segment_in%tangential_vel, turns, segment%tangential_vel)
6177+
if (allocated(segment_in%tangential_grad)) &
6178+
call rotate_array(segment_in%tangential_grad, turns, segment%tangential_grad)
6179+
if (allocated(segment_in%grad_normal)) &
6180+
call rotate_array(segment_in%grad_normal, turns, segment%grad_normal)
6181+
if (allocated(segment_in%grad_tan)) &
6182+
call rotate_array(segment_in%grad_tan, turns, segment%grad_tan)
6183+
if (allocated(segment_in%grad_gradient)) &
6184+
call rotate_array(segment_in%grad_gradient, turns, segment%grad_gradient)
6185+
if (allocated(segment_in%rx_norm_rad)) &
6186+
call rotate_array(segment_in%rx_norm_rad, turns, segment%ry_norm_rad)
6187+
if (allocated(segment_in%ry_norm_rad)) &
6188+
call rotate_array(segment_in%ry_norm_rad, turns, segment%rx_norm_rad)
6189+
if (allocated(segment_in%rx_norm_obl)) &
6190+
call rotate_array(segment_in%rx_norm_obl, turns, segment%ry_norm_obl)
6191+
if (allocated(segment_in%ry_norm_obl)) &
6192+
call rotate_array(segment_in%ry_norm_obl, turns, segment%rx_norm_obl)
6193+
if (allocated(segment_in%cff_normal)) &
6194+
call rotate_array(segment_in%cff_normal, turns, segment%cff_normal)
6195+
if (allocated(segment_in%nudged_normal_vel)) &
6196+
call rotate_array(segment_in%nudged_normal_vel, turns, segment%nudged_normal_vel)
6197+
if (allocated(segment_in%nudged_tangential_vel)) &
6198+
call rotate_array(segment_in%nudged_tangential_vel, turns, segment%nudged_tangential_vel)
6199+
if (allocated(segment_in%nudged_tangential_grad)) &
6200+
call rotate_array(segment_in%nudged_tangential_grad, turns, segment%nudged_tangential_grad)
6201+
if (associated(segment_in%tr_Reg)) then
6202+
do n = 1, segment_in%tr_Reg%ntseg
6203+
call rotate_array(segment_in%tr_Reg%tr(n)%tres, turns, segment%tr_Reg%tr(n)%tres)
6204+
! Testing this to see if it works for contant tres values. Probably wrong otherwise.
6205+
segment%tr_Reg%Tr(n)%is_initialized=.true.
6206+
enddo
6207+
endif
6208+
61486209
segment%temp_segment_data_exists = segment_in%temp_segment_data_exists
61496210
segment%salt_segment_data_exists = segment_in%salt_segment_data_exists
61506211
end subroutine rotate_OBC_segment_data

0 commit comments

Comments
 (0)