diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 8a45c43c4f..aacd03486d 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -455,7 +455,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then - if (abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) & + if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & + (OBC%segment(OBC%segnum_u(I,j))%specified)) & FAuI(I) = FAuI(I) + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo @@ -1279,7 +1280,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) enddo do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then - if (abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) & + if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & + (OBC%segment(OBC%segnum_v(i,J))%specified)) & FAvi(i) = FAvi(i) + & OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 7f40af8461..86aa5bddb7 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -90,10 +90,8 @@ module MOM_grid dyCu, & !< dyCu is delta y at u points, in m. IdyCu, & !< 1/dyCu in m-1. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell in m. - dy_Cu_obc, & !< The unblocked lengths of the u-faces of the h-cell in m for OBC. IareaCu, & !< The masked inverse areas of u-grid cells in m2. areaCu !< The areas of the u-grid cells in m2. - !> \todo dy_Cu_obc is not used? real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. @@ -104,7 +102,6 @@ module MOM_grid dyCv, & !< dyCv is delta y at v points, in m. IdyCv, & !< 1/dyCv in m-1. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell in m. - dx_Cv_obc, & !< The unblocked lengths of the v-faces of the h-cell in m for OBC. IareaCv, & !< The masked inverse areas of v-grid cells in m2. areaCv !< The areas of the v-grid cells in m2. @@ -504,8 +501,6 @@ subroutine allocate_metrics(G) ALLOC_(G%dx_Cv(isd:ied,JsdB:JedB)) ; G%dx_Cv(:,:) = 0.0 ALLOC_(G%dy_Cu(IsdB:IedB,jsd:jed)) ; G%dy_Cu(:,:) = 0.0 - ALLOC_(G%dx_Cv_obc(isd:ied,JsdB:JedB)) ; G%dx_Cv_obc(:,:) = 0.0 - ALLOC_(G%dy_Cu_obc(IsdB:IedB,jsd:jed)) ; G%dy_Cu_obc(:,:) = 0.0 ALLOC_(G%areaCu(IsdB:IedB,jsd:jed)) ; G%areaCu(:,:) = 0.0 ALLOC_(G%areaCv(isd:ied,JsdB:JedB)) ; G%areaCv(:,:) = 0.0 @@ -551,7 +546,6 @@ subroutine MOM_grid_end(G) DEALLOC_(G%geoLonCv) ; DEALLOC_(G%geoLonBu) DEALLOC_(G%dx_Cv) ; DEALLOC_(G%dy_Cu) - DEALLOC_(G%dx_Cv_obc) ; DEALLOC_(G%dy_Cu_obc) DEALLOC_(G%bathyT) ; DEALLOC_(G%CoriolisBu) DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c56982b671..69a8edf69a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -121,8 +121,8 @@ module MOM_open_boundary integer :: Ie_obc !< i-indices of boundary segment. integer :: Js_obc !< j-indices of boundary segment. integer :: Je_obc !< j-indices of boundary segment. - real :: Velocity_nudging_timescale_in !< Inverse nudging timescale on inflow (1/s). - real :: Velocity_nudging_timescale_out !< Inverse nudging timescale on outflow (1/s). + real :: Velocity_nudging_timescale_in !< Nudging timescale on inflow (s). + real :: Velocity_nudging_timescale_out !< Nudging timescale on outflow (s). logical :: on_pe !< true if segment is located in the computational 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 @@ -527,8 +527,8 @@ subroutine initialize_segment_data(G, OBC, PF) if (num_fields < 3) call MOM_error(FATAL, & "MOM_open_boundary, initialize_segment_data: "//& "Need at least three inputs for Flather") - segment%num_fields = num_fields ! these are at least three input fields required for the Flather option endif + segment%num_fields = num_fields ! these are at least three input fields required for the Flather option segment%temp_segment_data_exists=.false. segment%salt_segment_data_exists=.false. @@ -729,10 +729,11 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) allocate(tnudge(2)) call get_param(PF, mdl, segment_param_str(1:43), tnudge, & "Timescales in days for nudging along a segment,\n"//& - "for inflow, then outflow.", & + "for inflow, then outflow. Setting both to zero should\n"//& + "behave like SIMPLE obcs for the baroclinic velocities.", & fail_if_missing=.true.,default=0.,units="days") - OBC%segment(l_seg)%Velocity_nudging_timescale_in = 1.0/(tnudge(1)*86400.) - OBC%segment(l_seg)%Velocity_nudging_timescale_out = 1.0/(tnudge(2)*86400.) + OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. + OBC%segment(l_seg)%Velocity_nudging_timescale_out = tnudge(2)*86400. deallocate(tnudge) OBC%nudged_u_BCs_exist_globally = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then @@ -832,8 +833,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) "Timescales in days for nudging along a segment,\n"//& "for inflow, then outflow.", & fail_if_missing=.true.,default=0.,units="days") - OBC%segment(l_seg)%Velocity_nudging_timescale_in = 1.0/(tnudge(1)*86400.) - OBC%segment(l_seg)%Velocity_nudging_timescale_out = 1.0/(tnudge(2)*86400.) + OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. + OBC%segment(l_seg)%Velocity_nudging_timescale_out = tnudge(2)*86400. deallocate(tnudge) OBC%nudged_v_BCs_exist_globally = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then @@ -1204,12 +1205,14 @@ subroutine open_boundary_impose_normal_slope(OBC, G, depth) if (.not.associated(OBC)) return - if (.not.(OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) & + if (.not.(OBC%specified_u_BCs_exist_globally .or. OBC%specified_v_BCs_exist_globally .or. & + OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) & return do n=1,OBC%number_of_segments segment=>OBC%segment(n) - if (.not. segment%on_pe .or. segment%specified) cycle +! if (.not. segment%on_pe .or. segment%specified) cycle + if (.not. segment%on_pe) cycle if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed @@ -1358,7 +1361,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v real, intent(in) :: dt !< Appropriate timestep ! Local variables - real :: dhdt, dhdx, dhdy, gamma_u, gamma_h, gamma_v + real :: dhdt, dhdx, dhdy, gamma_u, gamma_h, gamma_v, gamma_2 real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation @@ -1423,7 +1426,6 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) elseif (segment%oblique) then dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 -! if (segment%oblique) then if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1431,15 +1433,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) else dhdy = segment%grad_normal(J,1,k) endif -! endif if (dhdt*dhdx < 0.0) dhdt = 0.0 Cx = min(dhdt*dhdx,rx_max) ! default to normal radiation -! Cy = 0.0 - cff = max(dhdx*dhdx,eps) -! if (segment%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) -! endif + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cy = min(cff,max(dhdt*dhdy,-cff)) segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I-1,j,k)) - & (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) elseif (segment%gradient) then @@ -1451,7 +1448,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) else tau = segment%Velocity_nudging_timescale_out endif - segment%normal_vel(I,j,k) = u_new(I,j,k) + dt*tau*(segment%nudged_normal_vel(I,j,k) - u_new(I,j,k)) + gamma_2 = dt / (tau + dt) + segment%normal_vel(I,j,k) = (1 - gamma_2) * u_new(I,j,k) + & + gamma_2 * segment%nudged_normal_vel(I,j,k) endif enddo; enddo endif @@ -1505,7 +1504,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) else tau = segment%Velocity_nudging_timescale_out endif - segment%normal_vel(I,j,k) = u_new(I,j,k) + dt*tau*(segment%nudged_normal_vel(I,j,k) - u_new(I,j,k)) + gamma_2 = dt / (tau + dt) + segment%normal_vel(I,j,k) = (1 - gamma_2) * u_new(I,j,k) + & + gamma_2 * segment%nudged_normal_vel(I,j,k) endif enddo; enddo endif @@ -1559,7 +1560,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) else tau = segment%Velocity_nudging_timescale_out endif - segment%normal_vel(i,J,k) = v_new(i,J,k) + dt*tau*(segment%nudged_normal_vel(i,J,k) - v_new(i,J,k)) + gamma_2 = dt / (tau + dt) + segment%normal_vel(i,J,k) = (1 - gamma_2) * v_new(i,J,k) + & + gamma_2 * segment%nudged_normal_vel(i,J,k) endif enddo; enddo endif @@ -1614,7 +1617,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) else tau = segment%Velocity_nudging_timescale_out endif - segment%normal_vel(i,J,k) = v_new(i,J,k) + dt*tau*(segment%nudged_normal_vel(i,J,k) - v_new(i,J,k)) + gamma_2 = dt / (tau + dt) + segment%normal_vel(i,J,k) = (1 - gamma_2) * v_new(i,J,k) + & + gamma_2 * segment%nudged_normal_vel(i,J,k) endif enddo; enddo end if @@ -2268,17 +2273,33 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then if (segment%field(m)%fid>0) then ! calculate external BT velocity and transport if needed - if((trim(segment%field(m)%name) == 'U' .and. segment%is_E_or_W) .or. & - (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S)) then + if (trim(segment%field(m)%name) == 'U' .and. segment%is_E_or_W) then + do j=js_obc2,je_obc + do i=is_obc2,ie_obc + segment%normal_trans_bt(i,j) = 0.0 + do k=1,G%ke + segment%normal_vel(i,j,k) = segment%field(m)%buffer_dst(i,j,k) + segment%normal_trans(i,j,k) = segment%field(m)%buffer_dst(i,j,k)*segment%h(i,j,k) * & + G%dyCu(I,j) + segment%normal_trans_bt(i,j)= segment%normal_trans_bt(i,j)+segment%normal_trans(i,j,k) + enddo + segment%normal_vel_bt(i,j) = segment%normal_trans_bt(i,j)/(max(segment%Htot(i,j),1.e-12) * & + G%dyCu(I,j)) + if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,j,:) = segment%normal_vel(i,j,:) + enddo + enddo + elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then do j=js_obc2,je_obc do i=is_obc2,ie_obc segment%normal_trans_bt(i,j) = 0.0 do k=1,G%ke segment%normal_vel(i,j,k) = segment%field(m)%buffer_dst(i,j,k) - segment%normal_trans(i,j,k) = segment%field(m)%buffer_dst(i,j,k)*segment%h(i,j,k) + segment%normal_trans(i,j,k) = segment%field(m)%buffer_dst(i,j,k)*segment%h(i,j,k) * & + G%dxCv(i,J) segment%normal_trans_bt(i,j)= segment%normal_trans_bt(i,j)+segment%normal_trans(i,j,k) enddo - segment%normal_vel_bt(i,j) = segment%normal_trans_bt(i,j)/max(segment%Htot(i,j),1.e-12) + segment%normal_vel_bt(i,j) = segment%normal_trans_bt(i,j)/(max(segment%Htot(i,j),1.e-12) * & + G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,j,:) = segment%normal_vel(i,j,:) enddo enddo diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index b6255dfaef..75892d19f3 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -63,7 +63,6 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) oG%dxCu(I,j) = dG%dxCu(I+ido,j+jdo) oG%dyCu(I,j) = dG%dyCu(I+ido,j+jdo) oG%dy_Cu(I,j) = dG%dy_Cu(I+ido,j+jdo) - oG%dy_Cu_obc(I,j) = dG%dy_Cu_obc(I+ido,j+jdo) oG%mask2dCu(I,j) = dG%mask2dCu(I+ido,j+jdo) oG%areaCu(I,j) = dG%areaCu(I+ido,j+jdo) @@ -76,7 +75,6 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) oG%dxCv(i,J) = dG%dxCv(i+ido,J+jdo) oG%dyCv(i,J) = dG%dyCv(i+ido,J+jdo) oG%dx_Cv(i,J) = dG%dx_Cv(i+ido,J+jdo) - oG%dx_Cv_obc(i,J) = dG%dx_Cv_obc(i+ido,J+jdo) oG%mask2dCv(i,J) = dG%mask2dCv(i+ido,J+jdo) oG%areaCv(i,J) = dG%areaCv(i+ido,J+jdo) @@ -137,7 +135,6 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%dyCu, oG%dxCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%dxCu, oG%dyCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%dy_Cu, oG%dx_Cv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) - call pass_vector(oG%dy_Cu_obc, oG%dx_Cv_obc, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%mask2dCu, oG%mask2dCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%IareaCu, oG%IareaCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%IareaCu, oG%IareaCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) @@ -209,7 +206,6 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) dG%dxCu(I,j) = oG%dxCu(I+ido,j+jdo) dG%dyCu(I,j) = oG%dyCu(I+ido,j+jdo) dG%dy_Cu(I,j) = oG%dy_Cu(I+ido,j+jdo) - dG%dy_Cu_obc(I,j) = oG%dy_Cu_obc(I+ido,j+jdo) dG%mask2dCu(I,j) = oG%mask2dCu(I+ido,j+jdo) dG%areaCu(I,j) = oG%areaCu(I+ido,j+jdo) @@ -222,7 +218,6 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) dG%dxCv(i,J) = oG%dxCv(i+ido,J+jdo) dG%dyCv(i,J) = oG%dyCv(i+ido,J+jdo) dG%dx_Cv(i,J) = oG%dx_Cv(i+ido,J+jdo) - dG%dx_Cv_obc(i,J) = oG%dx_Cv_obc(i+ido,J+jdo) dG%mask2dCv(i,J) = oG%mask2dCv(i+ido,J+jdo) dG%areaCv(i,J) = oG%areaCv(i+ido,J+jdo) @@ -284,7 +279,6 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%dyCu, dG%dxCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%dxCu, dG%dyCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%dy_Cu, dG%dx_Cv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) - call pass_vector(dG%dy_Cu_obc, dG%dx_Cv_obc, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%mask2dCu, dG%mask2dCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%IareaCu, dG%IareaCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%IareaCu, dG%IareaCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 8450b055ee..a11646aa2a 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -54,7 +54,6 @@ module MOM_dyn_horgrid dxCu, IdxCu, & ! dxCu is delta x at u points, in m, and IdxCu is 1/dxCu in m-1. dyCu, IdyCu, & ! dyCu is delta y at u points, in m, and IdyCu is 1/dyCu in m-1. dy_Cu, & ! The unblocked lengths of the u-faces of the h-cell in m. - dy_Cu_obc, & ! The unblocked lengths of the u-faces of the h-cell in m for OBC. IareaCu, & ! The masked inverse areas of u-grid cells in m2. areaCu ! The areas of the u-grid cells in m2. @@ -65,7 +64,6 @@ module MOM_dyn_horgrid dxCv, IdxCv, & ! dxCv is delta x at v points, in m, and IdxCv is 1/dxCv in m-1. dyCv, IdyCv, & ! dyCv is delta y at v points, in m, and IdyCv is 1/dyCv in m-1. dx_Cv, & ! The unblocked lengths of the v-faces of the h-cell in m. - dx_Cv_obc, & ! The unblocked lengths of the v-faces of the h-cell in m for OBC. IareaCv, & ! The masked inverse areas of v-grid cells in m2. areaCv ! The areas of the v-grid cells in m2. @@ -204,8 +202,6 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%dx_Cv(isd:ied,JsdB:JedB)) ; G%dx_Cv(:,:) = 0.0 allocate(G%dy_Cu(IsdB:IedB,jsd:jed)) ; G%dy_Cu(:,:) = 0.0 - allocate(G%dx_Cv_obc(isd:ied,JsdB:JedB)) ; G%dx_Cv_obc(:,:) = 0.0 - allocate(G%dy_Cu_obc(IsdB:IedB,jsd:jed)) ; G%dy_Cu_obc(:,:) = 0.0 allocate(G%areaCu(IsdB:IedB,jsd:jed)) ; G%areaCu(:,:) = 0.0 allocate(G%areaCv(isd:ied,JsdB:JedB)) ; G%areaCv(:,:) = 0.0 @@ -319,7 +315,6 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%geoLonCv) ; deallocate(G%geoLonBu) deallocate(G%dx_Cv) ; deallocate(G%dy_Cu) - deallocate(G%dx_Cv_obc) ; deallocate(G%dy_Cu_obc) deallocate(G%bathyT) ; deallocate(G%CoriolisBu) deallocate(G%dF_dx) ; deallocate(G%dF_dy) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 917e1b60ca..7788b79d9b 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1339,14 +1339,12 @@ subroutine initialize_masks(G, PF) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) - G%dy_Cu_obc(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) - G%dx_Cv_obc(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 25b018e734..cb8b91c0db 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1939,7 +1939,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) ! wind (m/s), friction velocity (m/s) and the boundary layer depth (m). ! Update (Jan/25): ! Converted from function to subroutine, now returns Langmuir number. -! Computs 10m wind internally, so only ustar and hbl need passed to +! Computes 10m wind internally, so only ustar and hbl need passed to ! subroutine. ! ! Qing Li, 160606 diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 08f6e20626..db54e599c6 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -518,10 +518,11 @@ 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 ! Tracer fluxes are set to prescribed values only for inflows from masked areas. - if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then + ! Now changing to simply fixed inflows. + if ((uhr(I,j,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_W) .or. & + (uhr(I,j,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_E)) then uhh(I) = uhr(I,j,k) - ! should the reservoir evolve for this case Kate ?? + ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) @@ -848,8 +849,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (J >= segment%HI%JsdB .and. J<= segment%HI%JedB) then do i=segment%HI%isd,segment%HI%ied ! Tracer fluxes are set to prescribed values only for inflows from masked areas. - if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then + ! Now changing to simply fixed inflows. + if ((vhr(i,J,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_S) .or. & + (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 diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index b5d31ef5fe..7035d72a26 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -194,11 +194,6 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! Local variables real, allocatable :: temp(:,:,:) - real, pointer, dimension(:,:,:) :: & - OBC_tr1_u => NULL(), & ! These arrays should be allocated and set to - OBC_tr1_v => NULL() ! specify the values of tracer 1 that should come - ! in through u- and v- points through the open - ! boundary conditions, in the same units as tr. character(len=32) :: name ! A variable's name in a NetCDF file. character(len=72) :: longname ! The long name of that variable. character(len=48) :: units ! The dimensions of the variable. @@ -283,11 +278,6 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (associated(OBC)) then call query_vardesc(CS%tr_desc(1), name, caller="USER_initialize_tracer") if (OBC%specified_v_BCs_exist_globally) then - allocate(OBC_tr1_v(G%isd:G%ied,G%jsd:G%jed,nz)) - do k=1,nz ; do j=G%jsd,G%jed ; do i=G%isd,G%ied - if (k < nz/2) then ; OBC_tr1_v(i,j,k) = 0.0 - else ; OBC_tr1_v(i,j,k) = 1.0 ; endif - enddo ; enddo ; enddo ! Steal from updated DOME in the fullness of time. else ! Steal from updated DOME in the fullness of time. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 1e0899bc0e..3b249864e4 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -225,11 +225,21 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) else segment%eta(I,j) = 0.0 segment%normal_vel_bt(I,j) = 0.0 - do k=1,nz - segment%nudged_normal_vel(I,j,k) = fac * CS%lambda / CS%F_0 * & + if (segment%nudged) then + do k=1,nz + segment%nudged_normal_vel(I,j,k) = fac * CS%lambda / CS%F_0 * & exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(CS%omega * time_sec) - enddo + enddo + elseif (segment%specified) then + do k=1,nz + segment%normal_vel(I,j,k) = fac * CS%lambda / CS%F_0 * & + exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & + cos(CS%omega * time_sec) + segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & + h(i+1,j,k) * G%dyCu(I,j) + enddo + endif endif enddo ; enddo else @@ -249,10 +259,19 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) else segment%eta(i,J) = 0.0 segment%normal_vel_bt(i,J) = 0.0 - do k=1,nz - segment%nudged_normal_vel(i,J,k) = fac * CS%lambda / CS%F_0 * & + if (segment%nudged) then + do k=1,nz + segment%nudged_normal_vel(i,J,k) = fac * CS%lambda / CS%F_0 * & + exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa + enddo + elseif (segment%specified) then + do k=1,nz + segment%normal_vel(i,J,k) = fac * CS%lambda / CS%F_0 * & exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - enddo + segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & + h(i,j+1,k) * G%dxCv(i,J) + enddo + endif endif enddo ; enddo endif