Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme.
194 type(ocean_grid_type),
intent(inout) :: G
195 type(verticalGrid_type),
intent(in) :: GV
196 type(unit_scale_type),
intent(in) :: US
197 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(inout) :: u_in
199 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(inout) :: v_in
201 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(inout) :: h_in
204 type(thermo_var_ptrs),
intent(in) :: tv
206 type(vertvisc_type),
intent(inout) :: visc
209 type(time_type),
intent(in) :: Time_local
211 real,
intent(in) :: dt
212 type(mech_forcing),
intent(in) :: forces
213 real,
dimension(:,:),
pointer :: p_surf_begin
216 real,
dimension(:,:),
pointer :: p_surf_end
219 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(inout) :: uh
221 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(inout) :: vh
223 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(inout) :: uhtr
226 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(inout) :: vhtr
229 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: eta_av
231 type(MOM_dyn_unsplit_RK2_CS),
pointer :: CS
233 type(VarMix_CS),
pointer :: VarMix
236 type(MEKE_type),
pointer :: MEKE
240 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp
241 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up
242 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp
243 real,
dimension(:,:),
pointer :: p_surf => null()
246 logical :: dyn_p_surf
247 integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
248 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
249 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
252 h_av(:,:,:) = 0; hp(:,:,:) = 0
256 dyn_p_surf =
associated(p_surf_begin) .and.
associated(p_surf_end)
258 call safe_alloc_ptr(p_surf,g%isd,g%ied,g%jsd,g%jed) ; p_surf(:,:) = 0.0
260 p_surf => forces%p_surf
267 call mom_state_chksum(
"Start Predictor ", u_in, v_in, h_in, uh, vh, g, gv, us)
271 call enable_averages(dt,time_local, cs%diag)
272 call cpu_clock_begin(id_clock_horvisc)
273 call horizontal_viscosity(u_in, v_in, h_in, cs%diffu, cs%diffv, meke, varmix, &
274 g, gv, us, cs%hor_visc_CSp)
275 call cpu_clock_end(id_clock_horvisc)
276 call disable_averaging(cs%diag)
277 call pass_vector(cs%diffu, cs%diffv, g%Domain, clock=id_clock_pass)
283 call cpu_clock_begin(id_clock_continuity)
286 call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, g, gv, us, cs%continuity_CSp, obc=cs%OBC)
287 call cpu_clock_end(id_clock_continuity)
288 call pass_var(hp, g%Domain, clock=id_clock_pass)
289 call pass_vector(uh, vh, g%Domain, clock=id_clock_pass)
292 call cpu_clock_begin(id_clock_mom_update)
293 do k=1,nz ;
do j=js-2,je+2 ;
do i=is-2,ie+2
294 h_av(i,j,k) = (h_in(i,j,k) + hp(i,j,k)) * 0.5
295 enddo ;
enddo ;
enddo 296 call cpu_clock_end(id_clock_mom_update)
299 call cpu_clock_begin(id_clock_cor)
300 call coradcalc(u_in, v_in, h_av, uh, vh, cs%CAu, cs%CAv, cs%OBC, cs%ADp, &
301 g, gv, us, cs%CoriolisAdv_CSp)
302 call cpu_clock_end(id_clock_cor)
305 call cpu_clock_begin(id_clock_pres)
306 if (dyn_p_surf)
then ;
do j=js-2,je+2 ;
do i=is-2,ie+2
307 p_surf(i,j) = 0.5*p_surf_begin(i,j) + 0.5*p_surf_end(i,j)
308 enddo ;
enddo ;
endif 309 call pressureforce(h_in, tv, cs%PFu, cs%PFv, g, gv, us, cs%PressureForce_CSp, cs%ALE_CSp, p_surf)
310 call cpu_clock_end(id_clock_pres)
311 call pass_vector(cs%PFu, cs%PFv, g%Domain, clock=id_clock_pass)
312 call pass_vector(cs%CAu, cs%CAv, g%Domain, clock=id_clock_pass)
314 if (
associated(cs%OBC)) then;
if (cs%OBC%update_OBC)
then 315 call update_obc_data(cs%OBC, g, gv, us, tv, h_in, cs%update_OBC_CSp, time_local)
317 if (
associated(cs%OBC))
then 318 call open_boundary_zero_normal_flow(cs%OBC, g, cs%PFu, cs%PFv)
319 call open_boundary_zero_normal_flow(cs%OBC, g, cs%CAu, cs%CAv)
320 call open_boundary_zero_normal_flow(cs%OBC, g, cs%diffu, cs%diffv)
324 call cpu_clock_begin(id_clock_mom_update)
325 do k=1,nz ;
do j=js,je ;
do i=isq,ieq
326 up(i,j,k) = g%mask2dCu(i,j) * (u_in(i,j,k) + dt_pred * &
327 ((cs%PFu(i,j,k) + cs%CAu(i,j,k)) + cs%diffu(i,j,k)))
328 enddo ;
enddo ;
enddo 329 do k=1,nz ;
do j=jsq,jeq ;
do i=is,ie
330 vp(i,j,k) = g%mask2dCv(i,j) * (v_in(i,j,k) + dt_pred * &
331 ((cs%PFv(i,j,k) + cs%CAv(i,j,k)) + cs%diffv(i,j,k)))
332 enddo ;
enddo ;
enddo 333 call cpu_clock_end(id_clock_mom_update)
336 call mom_accel_chksum(
"Predictor 1 accel", cs%CAu, cs%CAv, cs%PFu, cs%PFv,&
337 cs%diffu, cs%diffv, g, gv, us)
340 call cpu_clock_begin(id_clock_vertvisc)
341 call enable_averages(dt, time_local, cs%diag)
342 dt_visc = dt_pred ;
if (cs%use_correct_dt_visc) dt_visc = dt
343 call set_viscous_ml(u_in, v_in, h_av, tv, forces, visc, dt_visc, g, gv, us, cs%set_visc_CSp)
344 call disable_averaging(cs%diag)
346 call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, g, gv, us, cs%vertvisc_CSp, cs%OBC)
347 call vertvisc(up, vp, h_av, forces, visc, dt_pred, cs%OBC, cs%ADp, cs%CDp, &
348 g, gv, us, cs%vertvisc_CSp)
349 call cpu_clock_end(id_clock_vertvisc)
350 call pass_vector(up, vp, g%Domain, clock=id_clock_pass)
354 call cpu_clock_begin(id_clock_continuity)
355 call continuity(up, vp, h_in, hp, uh, vh, dt, g, gv, us, cs%continuity_CSp, obc=cs%OBC)
356 call cpu_clock_end(id_clock_continuity)
357 call pass_var(hp, g%Domain, clock=id_clock_pass)
358 call pass_vector(uh, vh, g%Domain, clock=id_clock_pass)
361 do k=1,nz ;
do j=js-2,je+2 ;
do i=is-2,ie+2
362 h_av(i,j,k) = (h_in(i,j,k) + hp(i,j,k)) * 0.5
363 enddo ;
enddo ;
enddo 366 call mom_state_chksum(
"Predictor 1", up, vp, h_av, uh, vh, g, gv, us)
369 call cpu_clock_begin(id_clock_cor)
370 call coradcalc(up, vp, h_av, uh, vh, cs%CAu, cs%CAv, cs%OBC, cs%ADp, &
371 g, gv, us, cs%CoriolisAdv_CSp)
372 call cpu_clock_end(id_clock_cor)
373 if (
associated(cs%OBC))
then 374 call open_boundary_zero_normal_flow(cs%OBC, g, cs%CAu, cs%CAv)
381 do k=1,nz ;
do j=js,je ;
do i=isq,ieq
382 up(i,j,k) = g%mask2dCu(i,j) * (u_in(i,j,k) + dt * (1.+cs%begw) * &
383 ((cs%PFu(i,j,k) + cs%CAu(i,j,k)) + cs%diffu(i,j,k)))
384 u_in(i,j,k) = g%mask2dCu(i,j) * (u_in(i,j,k) + dt * &
385 ((cs%PFu(i,j,k) + cs%CAu(i,j,k)) + cs%diffu(i,j,k)))
386 enddo ;
enddo ;
enddo 387 do k=1,nz ;
do j=jsq,jeq ;
do i=is,ie
388 vp(i,j,k) = g%mask2dCv(i,j) * (v_in(i,j,k) + dt * (1.+cs%begw) * &
389 ((cs%PFv(i,j,k) + cs%CAv(i,j,k)) + cs%diffv(i,j,k)))
390 v_in(i,j,k) = g%mask2dCv(i,j) * (v_in(i,j,k) + dt * &
391 ((cs%PFv(i,j,k) + cs%CAv(i,j,k)) + cs%diffv(i,j,k)))
392 enddo ;
enddo ;
enddo 396 call cpu_clock_begin(id_clock_vertvisc)
397 call vertvisc_coef(up, vp, h_av, forces, visc, dt, g, gv, us, cs%vertvisc_CSp, cs%OBC)
398 call vertvisc(up, vp, h_av, forces, visc, dt, cs%OBC, cs%ADp, cs%CDp, &
399 g, gv, us, cs%vertvisc_CSp, cs%taux_bot, cs%tauy_bot)
400 call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, g, gv, us, cs%vertvisc_CSp, cs%OBC)
401 call vertvisc(u_in, v_in, h_av, forces, visc, dt, cs%OBC, cs%ADp, cs%CDp,&
402 g, gv, us, cs%vertvisc_CSp, cs%taux_bot, cs%tauy_bot)
403 call cpu_clock_end(id_clock_vertvisc)
404 call pass_vector(up, vp, g%Domain, clock=id_clock_pass)
405 call pass_vector(u_in, v_in, g%Domain, clock=id_clock_pass)
409 call cpu_clock_begin(id_clock_continuity)
410 call continuity(up, vp, h_in, h_in, uh, vh, dt, g, gv, us, cs%continuity_CSp, obc=cs%OBC)
411 call cpu_clock_end(id_clock_continuity)
412 call pass_var(h_in, g%Domain, clock=id_clock_pass)
413 call pass_vector(uh, vh, g%Domain, clock=id_clock_pass)
417 do j=js-2,je+2 ;
do i=isq-2,ieq+2
418 uhtr(i,j,k) = uhtr(i,j,k) + dt*uh(i,j,k)
420 do j=jsq-2,jeq+2 ;
do i=is-2,ie+2
421 vhtr(i,j,k) = vhtr(i,j,k) + dt*vh(i,j,k)
426 call mom_state_chksum(
"Corrector", u_in, v_in, h_in, uh, vh, g, gv, us)
427 call mom_accel_chksum(
"Corrector accel", cs%CAu, cs%CAv, cs%PFu, cs%PFv, &
428 cs%diffu, cs%diffv, g, gv, us)
431 if (gv%Boussinesq)
then 432 do j=js,je ;
do i=is,ie ; eta_av(i,j) = -gv%Z_to_H*g%bathyT(i,j) ;
enddo ;
enddo 434 do j=js,je ;
do i=is,ie ; eta_av(i,j) = 0.0 ;
enddo ;
enddo 436 do k=1,nz ;
do j=js,je ;
do i=is,ie
437 eta_av(i,j) = eta_av(i,j) + h_av(i,j,k)
438 enddo ;
enddo ;
enddo 440 if (dyn_p_surf)
deallocate(p_surf)
444 if (cs%id_PFu > 0)
call post_data(cs%id_PFu, cs%PFu, cs%diag)
445 if (cs%id_PFv > 0)
call post_data(cs%id_PFv, cs%PFv, cs%diag)
446 if (cs%id_CAu > 0)
call post_data(cs%id_CAu, cs%CAu, cs%diag)
447 if (cs%id_CAv > 0)
call post_data(cs%id_CAv, cs%CAv, cs%diag)
450 if (cs%id_uh > 0)
call post_data(cs%id_uh, uh, cs%diag)
451 if (cs%id_vh > 0)
call post_data(cs%id_vh, vh, cs%diag)