12 implicit none ;
private
14 #include <MOM_memory.h>
16 public full_convection
21 subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, &
26 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
30 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
32 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
34 real,
dimension(:,:),
pointer :: p_surf
35 real,
intent(in) :: kddt_smooth
37 real,
optional,
intent(in) :: kddt_convect
39 integer,
optional,
intent(in) :: halo
42 real,
dimension(SZI_(G),SZK_(G)+1) :: &
48 real,
dimension(SZI_(G),SZK0_(G)) :: &
57 real,
dimension(SZI_(G),SZK_(G)+1) :: &
66 real,
dimension(SZI_(G),SZK_(G)+1) :: &
77 real,
dimension(SZI_(G),SZK_(G)+1) :: &
85 logical,
dimension(SZI_(G)) :: do_i
86 logical,
dimension(SZI_(G)) :: last_down
87 integer,
dimension(SZI_(G)) :: change_ct
89 integer :: changed_col
90 integer :: i, j, k, is, ie, js, je, nz, itt
92 if (
present(halo))
then
93 is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
95 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
99 if (.not.
associated(tv%eqn_of_state))
return
101 h_neglect = gv%H_subroundoff
103 if (
present(kddt_convect)) kap_dt_x2 = 2.0*kddt_convect
104 mix_len = (1.0e20 * nz) * (g%max_depth * gv%Z_to_H)
105 h0 = 1.0e-16*sqrt(kddt_smooth) + h_neglect
108 mix(:,:) = 0.0 ; d_b(:,:) = 1.0
110 te_b(:,:) = 0.0 ; se_b(:,:) = 0.0
112 call smoothed_drdt_drds(h, tv, kddt_smooth, drho_dt, drho_ds, g, gv, us, j, p_surf, halo)
115 do_i(i) = (g%mask2dT(i,j) > 0.0)
118 last_down(i) = .true.
120 te_a(i,0) = 0.0 ; se_a(i,0) = 0.0
126 do i=is,ie ; change_ct(i) = 0 ;
enddo
129 do k=2,nz ;
do i=is,ie ;
if (do_i(i))
then
131 h_a = h(i,j,k-1) + h_neglect ; h_b = h(i,j,k) + h_neglect
132 if (mix(i,k) <= 0.0)
then
133 if (is_unstable(drho_dt(i,k), drho_ds(i,k), h_a, h_b, mix(i,k-1), mix(i,k+1), &
134 tv%T(i,j,k-1), tv%T(i,j,k), tv%S(i,j,k-1), tv%S(i,j,k), &
135 te_a(i,k-2), te_b(i,k+1), se_a(i,k-2), se_b(i,k+1), &
136 d_a(i,k-1), d_b(i,k+1)))
then
138 if (kap_dt_x2 > 0.0) mix(i,k) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0)
139 change_ct(i) = change_ct(i) + 1
143 b_a = 1.0 / ((h_a + d_a(i,k-1)*mix(i,k-1)) + mix(i,k))
144 if (mix(i,k) <= 0.0)
then
145 c_a(i,k) = 0.0 ; d_a(i,k) = 1.0
147 d_a(i,k) = b_a * (h_a + d_a(i,k-1)*mix(i,k-1))
148 c_a(i,k) = 1.0 ;
if (d_a(i,k) > epsilon(b_a)) c_a(i,k) = b_a * mix(i,k)
152 te_a(i,k-1) = b_a * (h_a*tv%T(i,j,k-1) + mix(i,k-1)*te_a(i,k-2))
153 se_a(i,k-1) = b_a * (h_a*tv%S(i,j,k-1) + mix(i,k-1)*se_a(i,k-2))
155 te_a(i,k-1) = b_a * (h_a*tv%T(i,j,k-1))
156 se_a(i,k-1) = b_a * (h_a*tv%S(i,j,k-1))
158 endif ;
enddo ;
enddo
162 do i=is,ie ;
if (do_i(i))
then
163 if (change_ct(i) == 0)
then
164 last_down(i) = .true. ; do_i(i) = .false.
166 changed_col = changed_col + 1 ; change_ct(i) = 0
169 if (changed_col == 0)
exit
172 do k=nz,2,-1 ;
do i=is,ie ;
if (do_i(i))
then
174 h_a = h(i,j,k-1) + h_neglect ; h_b = h(i,j,k) + h_neglect
175 if (mix(i,k) <= 0.0)
then
176 if (is_unstable(drho_dt(i,k), drho_ds(i,k), h_a, h_b, mix(i,k-1), mix(i,k+1), &
177 tv%T(i,j,k-1), tv%T(i,j,k), tv%S(i,j,k-1), tv%S(i,j,k), &
178 te_a(i,k-2), te_b(i,k+1), se_a(i,k-2), se_b(i,k+1), &
179 d_a(i,k-1), d_b(i,k+1)))
then
181 if (kap_dt_x2 > 0.0) mix(i,k) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0)
182 change_ct(i) = change_ct(i) + 1
186 b_b = 1.0 / ((h_b + d_b(i,k+1)*mix(i,k+1)) + mix(i,k))
187 if (mix(i,k) <= 0.0)
then
188 c_b(i,k) = 0.0 ; d_b(i,k) = 1.0
190 d_b(i,k) = b_b * (h_b + d_b(i,k+1)*mix(i,k+1))
191 c_b(i,k) = 1.0 ;
if (d_b(i,k) > epsilon(b_b)) c_b(i,k) = b_b * mix(i,k)
195 te_b(i,k) = b_b * (h_b*tv%T(i,j,k) + mix(i,k+1)*te_b(i,k+1))
196 se_b(i,k) = b_b * (h_b*tv%S(i,j,k) + mix(i,k+1)*se_b(i,k+1))
198 te_b(i,k) = b_b * (h_b*tv%T(i,j,k))
199 se_b(i,k) = b_b * (h_b*tv%S(i,j,k))
201 endif ;
enddo ;
enddo
205 do i=is,ie ;
if (do_i(i))
then
206 if (change_ct(i) == 0)
then
207 last_down(i) = .false. ; do_i(i) = .false.
209 changed_col = changed_col + 1 ; change_ct(i) = 0
212 if (changed_col == 0)
exit
217 do i=is,ie ; do_i(i) = ((g%mask2dT(i,j) > 0.0) .and. last_down(i)) ;
enddo
218 do i=is,ie ;
if (do_i(i))
then
219 h_a = h(i,j,nz) + h_neglect
220 b_a = 1.0 / (h_a + d_a(i,nz)*mix(i,nz))
221 t_adj(i,j,nz) = b_a * (h_a*tv%T(i,j,nz) + mix(i,nz)*te_a(i,nz-1))
222 s_adj(i,j,nz) = b_a * (h_a*tv%S(i,j,nz) + mix(i,nz)*se_a(i,nz-1))
224 do k=nz-1,1,-1 ;
do i=is,ie ;
if (do_i(i))
then
225 t_adj(i,j,k) = te_a(i,k) + c_a(i,k+1)*t_adj(i,j,k+1)
226 s_adj(i,j,k) = se_a(i,k) + c_a(i,k+1)*s_adj(i,j,k+1)
227 endif ;
enddo ;
enddo
229 do i=is,ie ;
if (do_i(i))
then
236 do_i(i) = ((g%mask2dT(i,j) > 0.0) .and. .not.last_down(i))
238 h_b = h(i,j,1) + h_neglect
239 b_b = 1.0 / (h_b + d_b(i,2)*mix(i,2))
240 t_adj(i,j,1) = b_b * (h_b*tv%T(i,j,1) + mix(i,2)*te_b(i,2))
241 s_adj(i,j,1) = b_b * (h_b*tv%S(i,j,1) + mix(i,2)*se_b(i,2))
242 elseif (g%mask2dT(i,j) <= 0.0)
then
243 t_adj(i,j,1) = tv%T(i,j,1) ; s_adj(i,j,1) = tv%S(i,j,1)
246 do k=2,nz ;
do i=is,ie
248 t_adj(i,j,k) = te_b(i,k) + c_b(i,k)*t_adj(i,j,k-1)
249 s_adj(i,j,k) = se_b(i,k) + c_b(i,k)*s_adj(i,j,k-1)
250 elseif (g%mask2dT(i,j) <= 0.0)
then
251 t_adj(i,j,k) = tv%T(i,j,k) ; s_adj(i,j,k) = tv%S(i,j,k)
255 do i=is,ie ;
if (do_i(i))
then
279 end subroutine full_convection
284 function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_b, &
285 Te_aa, Te_bb, Se_aa, Se_bb, d_A, d_B)
286 real,
intent(in) :: drho_dt
287 real,
intent(in) :: drho_ds
288 real,
intent(in) :: h_a
289 real,
intent(in) :: h_b
290 real,
intent(in) :: mix_a
291 real,
intent(in) :: mix_b
292 real,
intent(in) :: t_a
293 real,
intent(in) :: t_b
294 real,
intent(in) :: s_a
295 real,
intent(in) :: s_b
296 real,
intent(in) :: te_aa
297 real,
intent(in) :: te_bb
298 real,
intent(in) :: se_aa
299 real,
intent(in) :: se_bb
300 real,
intent(in) :: d_a
301 real,
intent(in) :: d_b
302 logical :: is_unstable
309 is_unstable = (drho_dt * ((h_a * h_b * (t_b - t_a) + &
310 mix_a*mix_b * (d_a*te_bb - d_b*te_aa)) + &
311 (h_a*mix_b * (te_bb - d_b*t_a) + &
312 h_b*mix_a * (d_a*t_b - te_aa)) ) + &
313 drho_ds * ((h_a * h_b * (s_b - s_a) + &
314 mix_a*mix_b * (d_a*se_bb - d_b*se_aa)) + &
315 (h_a*mix_b * (se_bb - d_b*s_a) + &
316 h_b*mix_a * (d_a*s_b - se_aa)) ) < 0.0)
317 end function is_unstable
322 subroutine smoothed_drdt_drds(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, halo)
325 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
329 real,
intent(in) :: Kddt
330 real,
dimension(SZI_(G),SZK_(G)+1), &
333 real,
dimension(SZI_(G),SZK_(G)+1), &
337 integer,
intent(in) :: j
338 real,
dimension(:,:),
pointer :: p_surf
339 integer,
optional,
intent(in) :: halo
342 real :: mix(SZI_(G),SZK_(G)+1)
344 real :: b1(SZI_(G)), d1(SZI_(G))
345 real :: c1(SZI_(G),SZK_(G))
346 real :: T_f(SZI_(G),SZK_(G))
347 real :: S_f(SZI_(G),SZK_(G))
348 real :: pres(SZI_(G))
349 real :: T_EOS(SZI_(G))
350 real :: S_EOS(SZI_(G))
352 real :: h_neglect, h0
355 integer,
dimension(2) :: EOSdom
356 integer :: i, k, is, ie, nz
358 if (
present(halo))
then
359 is = g%isc-halo ; ie = g%iec+halo
361 is = g%isc ; ie = g%iec
365 h_neglect = gv%H_subroundoff
368 if (kddt <= 0.0)
then
369 do k=1,nz ;
do i=is,ie
370 t_f(i,k) = tv%T(i,j,k) ; s_f(i,k) = tv%S(i,j,k)
373 h0 = 1.0e-16*sqrt(kddt) + h_neglect
375 mix(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0)
377 h_tr = h(i,j,1) + h_neglect
378 b1(i) = 1.0 / (h_tr + mix(i,2))
379 d1(i) = b1(i) * h(i,j,1)
380 t_f(i,1) = (b1(i)*h_tr)*tv%T(i,j,1)
381 s_f(i,1) = (b1(i)*h_tr)*tv%S(i,j,1)
383 do k=2,nz-1 ;
do i=is,ie
384 mix(i,k+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0)
386 c1(i,k) = mix(i,k) * b1(i)
387 h_tr = h(i,j,k) + h_neglect
388 b1(i) = 1.0 / ((h_tr + d1(i)*mix(i,k)) + mix(i,k+1))
389 d1(i) = b1(i) * (h_tr + d1(i)*mix(i,k))
390 t_f(i,k) = b1(i) * (h_tr*tv%T(i,j,k) + mix(i,k)*t_f(i,k-1))
391 s_f(i,k) = b1(i) * (h_tr*tv%S(i,j,k) + mix(i,k)*s_f(i,k-1))
394 c1(i,nz) = mix(i,nz) * b1(i)
395 h_tr = h(i,j,nz) + h_neglect
396 b1(i) = 1.0 / (h_tr + d1(i)*mix(i,nz))
397 t_f(i,nz) = b1(i) * (h_tr*tv%T(i,j,nz) + mix(i,nz)*t_f(i,nz-1))
398 s_f(i,nz) = b1(i) * (h_tr*tv%S(i,j,nz) + mix(i,nz)*s_f(i,nz-1))
400 do k=nz-1,1,-1 ;
do i=is,ie
401 t_f(i,k) = t_f(i,k) + c1(i,k+1)*t_f(i,k+1)
402 s_f(i,k) = s_f(i,k) + c1(i,k+1)*s_f(i,k+1)
406 if (
associated(p_surf))
then
407 do i=is,ie ; pres(i) = p_surf(i,j) ;
enddo
409 do i=is,ie ; pres(i) = 0.0 ;
enddo
411 eosdom(:) = eos_domain(g%HI, halo)
412 call calculate_density_derivs(t_f(:,1), s_f(:,1), pres, dr_dt(:,1), dr_ds(:,1), tv%eqn_of_state, eosdom)
413 do i=is,ie ; pres(i) = pres(i) + h(i,j,1)*(gv%H_to_RZ*gv%g_Earth) ;
enddo
416 t_eos(i) = 0.5*(t_f(i,k-1) + t_f(i,k))
417 s_eos(i) = 0.5*(s_f(i,k-1) + s_f(i,k))
420 do i=is,ie ; pres(i) = pres(i) + h(i,j,k)*(gv%H_to_RZ*gv%g_Earth) ;
enddo
423 tv%eqn_of_state, eosdom)
425 end subroutine smoothed_drdt_drds