Skip to content

Small improvements #51

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
marshallward merged 10 commits into from
Nov 25, 2025
Merged

Small improvements #51

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
ce16ab0
fix segfault
edoyango Oct 23, 2025
7587f50
send wt_* to gpu for btstep_timeloop
edoyango Oct 23, 2025
e28e5e3
move uv_old download into if block
edoyango Oct 23, 2025
f944a11
port find_ustar_mech_forcing interface of find_ustar
edoyango Oct 23, 2025
b83768d
init I_Hbbl on GPU instead of CPU
edoyango Oct 23, 2025
ddb1554
clean up some loops
edoyango Oct 29, 2025
9f48f27
kji -> jki some loops
edoyango Oct 30, 2025
6220a8e
remove redundant CS%CA[u,v]_pref downloads
edoyango Oct 30, 2025
99121ce
fuse some loops in vertical viscosity
edoyango Oct 31, 2025
d05618e
move visc%nkml_visc_[u,v] to out of j loop
edoyango Oct 31, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/core/MOM.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -666,7 +666,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
call set_derived_forcing_fields(forces, fluxes, G, US, GV%Rho0)
endif
endif
!$omp target enter data map(to: forces, forces%taux, forces%tauy)
!$omp target enter data map(to: forces, forces%taux, forces%tauy, forces%ustar)

! This will be replaced later with the pressures from forces or fluxes if they are available.
if (associated(CS%tv%p_surf)) CS%tv%p_surf(:,:) = 0.0
Expand Down Expand Up @@ -726,7 +726,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
if (nonblocking_p_surf_update) then
call start_group_pass(pass_tau_ustar_psurf, G%Domain)
else
call do_group_pass(pass_tau_ustar_psurf, G%Domain)
call do_group_pass(pass_tau_ustar_psurf, G%Domain, omp_offload=.true.)
endif
call cpu_clock_end(id_clock_pass)

Expand Down
44 changes: 18 additions & 26 deletions src/core/MOM_PressureForce_FV.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1363,9 +1363,11 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp,
endif

! Set the pressure anomalies at the interfaces.
do k=1,nz
do concurrent (j=Jsq:Jeq+1, i=Isq:Ieq+1)
pa(i,j,K+1) = pa(i,j,K) + dpa(i,j,k)
do concurrent (j=Jsq:Jeq+1)
do k=1,nz
do concurrent (i=Isq:Ieq+1)
pa(i,j,K+1) = pa(i,j,K) + dpa(i,j,k)
enddo
enddo
enddo

Expand Down Expand Up @@ -1565,32 +1567,24 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp,
! assuming that the surface pressure anomaly varies linearly in x and y.
! If there is an ice-shelf or icebergs, this linear variation would need to be applied
! to an interior interface.
!$omp target
!$omp parallel loop collapse(2)
do j=js,je ; do I=Isq,Ieq
do concurrent (j=js:je, I=Isq:Ieq)
intx_pa(I,j,1) = 0.5*(pa(i,j,1) + pa(i+1,j,1))
enddo ; enddo
!$omp parallel loop collapse(2)
do J=Jsq,Jeq ; do i=is,ie
enddo
do concurrent (J=Jsq:Jeq, i=is:ie)
inty_pa(i,J,1) = 0.5*(pa(i,j,1) + pa(i,j+1,1))
enddo ; enddo
!$omp end target
enddo
endif

!$omp target
do k=1,nz
Comment thread
edoyango marked this conversation as resolved.
!$omp parallel loop collapse(2)
do j=js,je ; do I=Isq,Ieq
do concurrent (j=js:je, I=Isq:Ieq)
intx_pa(I,j,K+1) = intx_pa(I,j,K) + intx_dpa(I,j,k)
enddo ; enddo
enddo
enddo
do k=1,nz
!$omp parallel loop collapse(2)
do J=Jsq,Jeq ; do i=is,ie
do concurrent (J=Jsq:Jeq, i=is:ie)
inty_pa(i,J,K+1) = inty_pa(i,J,K) + inty_dpa(i,J,k)
enddo ; enddo
enddo
enddo
!$omp end target

if (CS%reset_intxpa_integral) then
! Having stored the pressure gradient info, we can work out where the first nonvanished layers is
Expand Down Expand Up @@ -1930,13 +1924,11 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp,
enddo
endif

do k=1,nz
do concurrent (j=js:je, I=Isq:Ieq)
PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j)
enddo
do concurrent (J=Jsq:Jeq, i=is:ie)
PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J)
enddo
do concurrent (k=1:nz, j=js:je, I=Isq:Ieq)
PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j)
enddo
do concurrent (k=1:nz, J=Jsq:Jeq, i=is:ie)
PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J)
enddo

!$omp end target data
Expand Down
24 changes: 14 additions & 10 deletions src/core/MOM_PressureForce_Montgomery.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -689,17 +689,19 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star)

if (use_EOS) then
if (present(rho_star)) then
do concurrent (j=Jsq:Jeq+1, i=Isq:Ieq+1)
do concurrent (j=Jsq:Jeq+1)
do concurrent (i=Isq:Ieq+1)
Ihtot(i,j) = GV%H_to_Z / ((e(i,j,1) - e(i,j,nz+1)) + dz_neglect)
pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z
enddo

do k=2,nz
do concurrent (j=Jsq:Jeq+1, i=Isq:Ieq+1)
do concurrent (i=Isq:Ieq+1)
pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k) - rho_star(i,j,k-1)) &
* ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i,j))
enddo
enddo
enddo
else
!$omp target data &
!$omp map(alloc: EOSdom, press, T_int, S_int, rho_in_situ) &
Expand Down Expand Up @@ -743,14 +745,16 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star)
!$omp end target data
endif
else
do concurrent (j=Jsq:Jeq+1, i=Isq:Ieq+1)
Ihtot(i,j) = 1.0 / ((e(i,j,1) - e(i,j,nz+1)) + dz_neglect)
pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z
enddo
do k=2,nz
do concurrent (j=Jsq:Jeq+1, i=Isq:Ieq+1)
pbce(i,j,k) = pbce(i,j,k-1) + (GV%g_prime(K) * GV%H_to_Z) &
* ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i,j))
do concurrent (j=Jsq:Jeq+1)
do concurrent (i=Isq:Ieq+1)
Ihtot(i,j) = 1.0 / ((e(i,j,1) - e(i,j,nz+1)) + dz_neglect)
pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z
enddo
do k=2,nz
do concurrent (i=Isq:Ieq+1)
pbce(i,j,k) = pbce(i,j,k-1) + (GV%g_prime(K) * GV%H_to_Z) &
* ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i,j))
enddo
enddo
enddo
endif
Expand Down
Loading