From 4d245d6b7448182c38c737a2e2f558f3965e692a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 5 Feb 2020 13:59:46 -0500 Subject: [PATCH] Segment index added for several OBC segment flags In setup_[uv]_point_obc, a number of flags for each segment were assigned without index (OBC%segment%flag), which was causing all segments to be assigned the same value. This could problems with, say, `[uv]_value_needed` flags, which have different values depending on if they are E-W or N-S oriented. This patch adds the index to the assignments. --- src/core/MOM_open_boundary.F90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 822ca6486f..2fdfad4b59 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -904,8 +904,8 @@ subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%open = .true. OBC%Flather_u_BCs_exist_globally = .true. OBC%open_u_BCs_exist_globally = .true. - OBC%segment%z_values_needed = .true. - OBC%segment%u_values_needed = .true. + OBC%segment(l_seg)%z_values_needed = .true. + OBC%segment(l_seg)%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'ORLANSKI') then OBC%segment(l_seg)%radiation = .true. OBC%segment(l_seg)%open = .true. @@ -933,14 +933,14 @@ subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_u_BCs_exist_globally = .true. - OBC%segment%u_values_needed = .true. + OBC%segment(l_seg)%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_u_BCs_exist_globally = .true. - OBC%segment%v_values_needed = .true. + OBC%segment(l_seg)%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then OBC%segment(l_seg)%nudged_grad = .true. - OBC%segment%g_values_needed = .true. + OBC%segment(l_seg)%g_values_needed = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -948,13 +948,13 @@ subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_u_BCs_exist_globally = .true. ! This avoids deallocation - OBC%segment%u_values_needed = .true. + OBC%segment(l_seg)%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then OBC%segment(l_seg)%specified_tan = .true. - OBC%segment%v_values_needed = .true. + OBC%segment(l_seg)%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_GRAD') then OBC%segment(l_seg)%specified_grad = .true. - OBC%segment%g_values_needed = .true. + OBC%segment(l_seg)%g_values_needed = .true. else call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc: "//& "String '"//trim(action_str(a_loop))//"' not understood.") @@ -1045,8 +1045,8 @@ subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%open = .true. OBC%Flather_v_BCs_exist_globally = .true. OBC%open_v_BCs_exist_globally = .true. - OBC%segment%z_values_needed = .true. - OBC%segment%v_values_needed = .true. + OBC%segment(l_seg)%z_values_needed = .true. + OBC%segment(l_seg)%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'ORLANSKI') then OBC%segment(l_seg)%radiation = .true. OBC%segment(l_seg)%open = .true. @@ -1074,14 +1074,14 @@ subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_v_BCs_exist_globally = .true. - OBC%segment%v_values_needed = .true. + OBC%segment(l_seg)%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_v_BCs_exist_globally = .true. - OBC%segment%u_values_needed = .true. + OBC%segment(l_seg)%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then OBC%segment(l_seg)%nudged_grad = .true. - OBC%segment%g_values_needed = .true. + OBC%segment(l_seg)%g_values_needed = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -1089,13 +1089,13 @@ subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_v_BCs_exist_globally = .true. ! This avoids deallocation - OBC%segment%v_values_needed = .true. + OBC%segment(l_seg)%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then OBC%segment(l_seg)%specified_tan = .true. - OBC%segment%u_values_needed = .true. + OBC%segment(l_seg)%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_GRAD') then OBC%segment(l_seg)%specified_grad = .true. - OBC%segment%g_values_needed = .true. + OBC%segment(l_seg)%g_values_needed = .true. else call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc: "//& "String '"//trim(action_str(a_loop))//"' not understood.")