@@ -2922,8 +2922,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
29222922 endif
29232923end subroutine find_coupling_coef
29242924
2925- ! > Velocity components which exceed a threshold for physically reasonable values
2926- ! ! are truncated. Optionally, any column with excessive velocities may be sent
2925+ ! > Velocity components which exceed a threshold for physically reasonable values are truncated,
2926+ ! ! and the running sum of the number of trunctionas within the non-symmetric memory computational
2927+ ! ! domain is incremmented. Optionally, any column with excessive velocities may be sent
29272928! ! to a diagnostic reporting subroutine.
29282929subroutine vertvisc_limit_vel (u , v , h , ADp , CDp , forces , visc , dt , G , GV , US , CS )
29292930 type (ocean_grid_type), intent (in ) :: G ! < Ocean grid structure
@@ -2953,7 +2954,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
29532954 is = G% isc ; ie = G% iec ; js = G% jsc ; je = G% jec ; nz = GV% ke
29542955 Isq = G% IscB ; Ieq = G% IecB ; Jsq = G% JscB ; Jeq = G% JecB
29552956
2956- H_report = 6 .0 * GV% Angstrom_H
2957+ H_report = 3 .0 * GV% Angstrom_H
29572958
29582959 if (len_trim (CS% u_trunc_file) > 0 ) then
29592960 ! $OMP parallel do default(shared) private(trunc_any,CFL)
@@ -2983,10 +2984,12 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
29832984 do k= 1 ,nz ; do I= Isq,Ieq
29842985 if ((u(I,j,k) * (dt * G% dy_Cu(I,j))) * G% IareaT(i+1 ,j) < - CS% CFL_trunc) then
29852986 u(I,j,k) = (- 0.9 * CS% CFL_trunc) * (G% areaT(i+1 ,j) / (dt * G% dy_Cu(I,j)))
2986- if (h(i,j,k) + h(i+1 ,j,k) > H_report) CS% ntrunc = CS% ntrunc + 1
2987+ if (((I >= G% isc) .and. (I <= G% iec) .and. (j >= G% jsc) .and. (j <= G% jec)) .and. &
2988+ (CS% h_u(I,j,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
29872989 elseif ((u(I,j,k) * (dt * G% dy_Cu(I,j))) * G% IareaT(i,j) > CS% CFL_trunc) then
29882990 u(I,j,k) = (0.9 * CS% CFL_trunc) * (G% areaT(i,j) / (dt * G% dy_Cu(I,j)))
2989- if (h(i,j,k) + h(i+1 ,j,k) > H_report) CS% ntrunc = CS% ntrunc + 1
2991+ if (((I >= G% isc) .and. (I <= G% iec) .and. (j >= G% jsc) .and. (j <= G% jec)) .and. &
2992+ (CS% h_u(I,j,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
29902993 endif
29912994 enddo ; enddo
29922995 endif
@@ -2997,10 +3000,12 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
29973000 if (abs (u(I,j,k)) < CS% vel_underflow) then ; u(I,j,k) = 0.0
29983001 elseif ((u(I,j,k) * (dt * G% dy_Cu(I,j))) * G% IareaT(i+1 ,j) < - CS% CFL_trunc) then
29993002 u(I,j,k) = (- 0.9 * CS% CFL_trunc) * (G% areaT(i+1 ,j) / (dt * G% dy_Cu(I,j)))
3000- if (h(i,j,k) + h(i+1 ,j,k) > H_report) CS% ntrunc = CS% ntrunc + 1
3003+ if (((I >= G% isc) .and. (I <= G% iec) .and. (j >= G% jsc) .and. (j <= G% jec)) .and. &
3004+ (CS% h_u(I,j,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
30013005 elseif ((u(I,j,k) * (dt * G% dy_Cu(I,j))) * G% IareaT(i,j) > CS% CFL_trunc) then
30023006 u(I,j,k) = (0.9 * CS% CFL_trunc) * (G% areaT(i,j) / (dt * G% dy_Cu(I,j)))
3003- if (h(i,j,k) + h(i+1 ,j,k) > H_report) CS% ntrunc = CS% ntrunc + 1
3007+ if (((I >= G% isc) .and. (I <= G% iec) .and. (j >= G% jsc) .and. (j <= G% jec)) .and. &
3008+ (CS% h_u(I,j,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
30043009 endif
30053010 enddo ; enddo ; enddo
30063011 endif
@@ -3041,10 +3046,12 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
30413046 do k= 1 ,nz ; do i= is,ie
30423047 if ((v(i,J,k) * (dt * G% dx_Cv(i,J))) * G% IareaT(i,j+1 ) < - CS% CFL_trunc) then
30433048 v(i,J,k) = (- 0.9 * CS% CFL_trunc) * (G% areaT(i,j+1 ) / (dt * G% dx_Cv(i,J)))
3044- if (h(i,j,k) + h(i,j+1 ,k) > H_report) CS% ntrunc = CS% ntrunc + 1
3049+ if (((i >= G% isc) .and. (i <= G% iec) .and. (J >= G% jsc) .and. (J <= G% jec)) .and. &
3050+ (CS% h_v(i,J,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
30453051 elseif ((v(i,J,k) * (dt * G% dx_Cv(i,J))) * G% IareaT(i,j) > CS% CFL_trunc) then
30463052 v(i,J,k) = (0.9 * CS% CFL_trunc) * (G% areaT(i,j) / (dt * G% dx_Cv(i,J)))
3047- if (h(i,j,k) + h(i,j+1 ,k) > H_report) CS% ntrunc = CS% ntrunc + 1
3053+ if (((i >= G% isc) .and. (i <= G% iec) .and. (J >= G% jsc) .and. (J <= G% jec)) .and. &
3054+ (CS% h_v(i,J,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
30483055 endif
30493056 enddo ; enddo
30503057 endif
@@ -3055,10 +3062,12 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
30553062 if (abs (v(i,J,k)) < CS% vel_underflow) then ; v(i,J,k) = 0.0
30563063 elseif ((v(i,J,k) * (dt * G% dx_Cv(i,J))) * G% IareaT(i,j+1 ) < - CS% CFL_trunc) then
30573064 v(i,J,k) = (- 0.9 * CS% CFL_trunc) * (G% areaT(i,j+1 ) / (dt * G% dx_Cv(i,J)))
3058- if (h(i,j,k) + h(i,j+1 ,k) > H_report) CS% ntrunc = CS% ntrunc + 1
3065+ if (((i >= G% isc) .and. (i <= G% iec) .and. (J >= G% jsc) .and. (J <= G% jec)) .and. &
3066+ (CS% h_v(i,J,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
30593067 elseif ((v(i,J,k) * (dt * G% dx_Cv(i,J))) * G% IareaT(i,j) > CS% CFL_trunc) then
30603068 v(i,J,k) = (0.9 * CS% CFL_trunc) * (G% areaT(i,j) / (dt * G% dx_Cv(i,J)))
3061- if (h(i,j,k) + h(i,j+1 ,k) > H_report) CS% ntrunc = CS% ntrunc + 1
3069+ if (((i >= G% isc) .and. (i <= G% iec) .and. (J >= G% jsc) .and. (J <= G% jec)) .and. &
3070+ (CS% h_v(i,J,k) > H_report)) CS% ntrunc = CS% ntrunc + 1
30623071 endif
30633072 enddo ; enddo ; enddo
30643073 endif
0 commit comments