u += dt*du_drag, v += dt*dv_drag over the whole face array —
layers outside the top boundary layer carry an exact zero.
No-op when the slot is disabled (the buffers are (1,1,1)
placeholders then). no_wait semantics mirror
ocean_bottom_drag_apply_tendencies: .true. runs the apply on
OpenACC queue 1 and returns WITHOUT syncing, so the batched
velocity-apply chain waits once. Not pure (async/wait
directives).
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(ocean_top_drag_t), | intent(in) | :: | this | |||
| type(multilayer_state_t), | intent(inout) | :: | ms | |||
| real(kind=wp), | intent(in) | :: | dt | |||
| logical, | intent(in), | optional | :: | no_wait |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| integer, | private | :: | i | ||||
| integer, | private | :: | j | ||||
| integer, | private | :: | k | ||||
| logical, | private | :: | lwait | ||||
| integer, | private | :: | nx_face | ||||
| integer, | private | :: | nx_vface | ||||
| integer, | private | :: | ny_face | ||||
| integer, | private | :: | ny_uface | ||||
| integer, | private | :: | nz |
subroutine ocean_top_drag_apply_tendencies(this, ms, dt, no_wait) !! `u += dt*du_drag`, `v += dt*dv_drag` over the whole face array — !! layers outside the top boundary layer carry an exact zero. !! !! No-op when the slot is disabled (the buffers are `(1,1,1)` !! placeholders then). `no_wait` semantics mirror !! `ocean_bottom_drag_apply_tendencies`: `.true.` runs the apply on !! OpenACC queue 1 and returns WITHOUT syncing, so the batched !! velocity-apply chain waits once. Not `pure` (async/wait !! directives). type(ocean_top_drag_t), intent(in) :: this type(multilayer_state_t), intent(inout) :: ms real(wp), intent(in) :: dt logical, intent(in), optional :: no_wait integer :: i, j, k, nx_face, ny_uface, nx_vface, ny_face, nz logical :: lwait if (.not. this%enable) return lwait = .true. if (present(no_wait)) lwait = .not. no_wait nx_face = size(ms%u_face_x_layer, 1) ny_uface = size(ms%u_face_x_layer, 2) nx_vface = size(ms%v_face_y_layer, 1) ny_face = size(ms%v_face_y_layer, 2) nz = ms%nz_ml !$acc kernels async(1) do concurrent(k=1:nz, j=1:ny_uface, i=1:nx_face) ms%u_face_x_layer(i, j, k) = ms%u_face_x_layer(i, j, k) + & dt*this%du_drag%data(i, j, k) end do do concurrent(k=1:nz, j=1:ny_face, i=1:nx_vface) ms%v_face_y_layer(i, j, k) = ms%v_face_y_layer(i, j, k) + & dt*this%dv_drag%data(i, j, k) end do !$acc end kernels if (lwait) then !$acc wait(1) end if end subroutine ocean_top_drag_apply_tendencies