Skip to content

Commit fbbcc83

Browse files
Raphael DussinRaphael Dussin
Raphael Dussin
authored and
Raphael Dussin
committed
more FMAs
1 parent d4b04fe commit fbbcc83

File tree

1 file changed

+22
-22
lines changed

1 file changed

+22
-22
lines changed

‎src/parameterizations/lateral/MOM_internal_tides.F90‎

Lines changed: 22 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -458,8 +458,8 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
458458
f2 = 0.25*((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
459459
(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
460460
if (CS%frequency(fr)**2 > f2) then
461-
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * &
462-
CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr)
461+
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + (dt*frac_per_sector*(1.0-CS%q_itides) * &
462+
CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr))
463463
else
464464
! zero out input TKE value to get correct diagnostics
465465
TKE_itidal_input(i,j,fr) = 0.
@@ -472,8 +472,8 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
472472
f2 = 0.25*((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
473473
(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
474474
if (CS%frequency(fr)**2 > f2) then
475-
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * &
476-
CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr)
475+
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + (dt*frac_per_sector*(1.0-CS%q_itides) * &
476+
CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr))
477477
else
478478
! zero out input TKE value to get correct diagnostics
479479
TKE_itidal_input(i,j,fr) = 0.
@@ -676,7 +676,7 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
676676
! Calculate loss rate and apply loss over the time step ; apply the same drag timescale
677677
! to each En component (technically not correct; fix later)
678678
En_b = CS%En(i,j,a,fr,m) ! save previous value
679-
En_a = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%decay_rate) ! implicit update
679+
En_a = CS%En(i,j,a,fr,m) / (1.0 + (dt * CS%decay_rate)) ! implicit update
680680
CS%TKE_leak_loss(i,j,a,fr,m) = (En_b - En_a) * I_dt ! compute exact loss rate [H Z2 T-3 ~> m3 s-3 or W m-2]
681681
CS%En(i,j,a,fr,m) = En_a ! update value
682682
enddo ; enddo ; enddo ; enddo ; enddo
@@ -730,7 +730,7 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
730730
call get_barotropic_tidal_vel(G, vel_btTide, CS%nFreq, inttide_input_CSp)
731731

732732
do fr=1,CS%Nfreq ; do j=jsd,jed ; do i=isd,ied
733-
tot_vel_btTide2(i,j) = tot_vel_btTide2(i,j) + vel_btTide(i,j,fr)**2
733+
tot_vel_btTide2(i,j) = tot_vel_btTide2(i,j) + (vel_btTide(i,j,fr)**2)
734734
enddo ; enddo ; enddo
735735

736736
do k=1,GV%ke ; do j=jsd,jed ; do i=isd,ied
@@ -741,15 +741,15 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
741741
do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do j=jsd,jed ; do i=isd,ied
742742
I_D_here = 1.0 / (max(htot(i,j), CS%drag_min_depth))
743743
drag_scale(i,j,fr,m) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*tot_vel_btTide2(i,j) + &
744-
tot_En_mode(i,j,fr,m) * I_D_here)) * GV%Z_to_H*I_D_here
744+
(tot_En_mode(i,j,fr,m) * I_D_here))) * GV%Z_to_H*I_D_here
745745
enddo ; enddo ; enddo ; enddo
746746
else
747747
do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do j=jsd,jed ; do i=isd,ied
748748
I_D_here = 1.0 / (max(htot(i,j), CS%drag_min_depth))
749749
I_mass = GV%RZ_to_H * I_D_here
750750
drag_scale(i,j,fr,m) = (CS%cdrag * (Rho_bot(i,j)*I_mass)) * &
751751
sqrt(max(0.0, US%L_to_Z**2*tot_vel_btTide2(i,j) + &
752-
tot_En_mode(i,j,fr,m) * I_D_here))
752+
(tot_En_mode(i,j,fr,m) * I_D_here)))
753753
enddo ; enddo ; enddo ; enddo
754754
endif
755755

@@ -760,7 +760,7 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
760760
! Calculate loss rate and apply loss over the time step ; apply the same drag timescale
761761
! to each En component (technically not correct; fix later)
762762
En_b = CS%En(i,j,a,fr,m)
763-
En_a = CS%En(i,j,a,fr,m) / (1.0 + dt * drag_scale(i,j,fr,m)) ! implicit update
763+
En_a = CS%En(i,j,a,fr,m) / (1.0 + (dt * drag_scale(i,j,fr,m))) ! implicit update
764764
CS%TKE_quad_loss(i,j,a,fr,m) = (En_b - En_a) * I_dt
765765
CS%En(i,j,a,fr,m) = En_a
766766
enddo ; enddo ; enddo ; enddo ; enddo
@@ -816,13 +816,13 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
816816

817817
f2 = (0.25*(G%CoriolisBu(I,J) + G%CoriolisBu(max(I-1,1),max(J-1,1)) + &
818818
G%CoriolisBu(I,max(J-1,1)) + G%CoriolisBu(max(I-1,1),J)))**2
819-
Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2)
819+
Kmag2 = (freq2 - f2) / ((cn(i,j,m)**2) + (cn_subRO**2))
820820

821821

822822
! Back-calculate amplitude from energy equation
823823
if ( (G%mask2dT(i,j) > 0.5) .and. (freq2*Kmag2 > 0.0)) then
824824
! Units here are [R Z ~> kg m-2]
825-
KE_term = 0.25*GV%H_to_RZ*( ((freq2 + f2) / (freq2*Kmag2))*US%L_to_Z**2*CS%int_U2(i,j,m) + &
825+
KE_term = 0.25*GV%H_to_RZ*( (((freq2 + f2) / (freq2*Kmag2))*US%L_to_Z**2*CS%int_U2(i,j,m)) + &
826826
CS%int_w2(i,j,m) )
827827
PE_term = 0.25*GV%H_to_RZ*( CS%int_N2w2(i,j,m) / freq2 )
828828

@@ -902,7 +902,7 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
902902
! Calculate horizontal phase velocity magnitudes
903903
f2 = 0.25*((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
904904
(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
905-
Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2)
905+
Kmag2 = (freq2 - f2) / ((cn(i,j,m)**2) + (cn_subRO**2))
906906
c_phase = 0.0
907907
CS%TKE_Froude_loss(i,j,:,fr,m) = 0. ! init for all angles
908908
if (Kmag2 > 0.0) then
@@ -979,7 +979,7 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
979979
if (CS%refl_pref_logical(i,j)) then
980980
En_b = CS%En(i,j,a,fr,m)
981981
En_a = (CS%En(i,j,a,fr,m) * (CS%En(i,j,a,fr,m) + en_subRO)) / &
982-
((CS%En(i,j,a,fr,m) + en_subRO) + dt * CS%TKE_slope_loss(i,j,a,fr,m))
982+
((CS%En(i,j,a,fr,m) + en_subRO) + (dt * CS%TKE_slope_loss(i,j,a,fr,m)))
983983
CS%TKE_residual_loss(i,j,a,fr,m) = (En_b - En_a) * I_dt
984984
CS%En(i,j,a,fr,m) = En_a
985985
endif
@@ -1328,7 +1328,7 @@ subroutine itidal_lowmode_loss(G, GV, US, CS, Nb, Rho_bot, Ub, En, TKE_loss_fixe
13281328
TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! [H Z2 T-3 ~> m3 s-3 or W m-2]
13291329
loss_rate = TKE_loss(i,j,a,fr,m) / (En(i,j,a,fr,m) + En_negl) ! [T-1 ~> s-1]
13301330
En_b = En(i,j,a,fr,m)
1331-
En_a = En(i,j,a,fr,m) / (1.0 + dt*loss_rate)
1331+
En_a = En(i,j,a,fr,m) / (1.0 + (dt*loss_rate))
13321332
TKE_loss(i,j,a,fr,m) = (En_b - En_a) * I_dt ! overwrite with exact value
13331333
En(i,j,a,fr,m) = En_a
13341334
enddo
@@ -1855,15 +1855,15 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang)
18551855
do j=js,je ; do I=is-1,ie
18561856
! wgt = 0 if local cn == 0, wgt = 0.5 if both contiguous values != 0
18571857
! and wgt = 1 if neighbour cn == 0
1858-
wgt1 = cnmask(i,j) - 0.5 * cnmask(i,j) * cnmask(i+1,j)
1859-
wgt2 = cnmask(i+1,j) - 0.5 * cnmask(i,j) * cnmask(i+1,j)
1860-
cn_u(I,j) = wgt1*cn(i,j) + wgt2*cn(i+1,j)
1858+
wgt1 = cnmask(i,j) - (0.5 * cnmask(i,j) * cnmask(i+1,j))
1859+
wgt2 = cnmask(i+1,j) - (0.5 * cnmask(i,j) * cnmask(i+1,j))
1860+
cn_u(I,j) = (wgt1*cn(i,j)) + (wgt2*cn(i+1,j))
18611861
enddo ; enddo
18621862

18631863
do J=js-1,je ; do i=is,ie
1864-
wgt1 = cnmask(i,j) - 0.5 * cnmask(i,j) * cnmask(i,j+1)
1865-
wgt2 = cnmask(i,j+1) - 0.5 * cnmask(i,j) * cnmask(i,j+1)
1866-
cn_v(i,J) = wgt1*cn(i,j) + wgt2*cn(i,j+1)
1864+
wgt1 = cnmask(i,j) - (0.5 * cnmask(i,j) * cnmask(i,j+1))
1865+
wgt2 = cnmask(i,j+1) - (0.5 * cnmask(i,j) * cnmask(i,j+1))
1866+
cn_v(i,J) = (wgt1*cn(i,j)) + (wgt2*cn(i,j+1))
18671867
enddo ; enddo
18681868

18691869
Ifreq = 1.0 / freq
@@ -1915,7 +1915,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang)
19151915

19161916
! Determine the energy fluxes in angular orientation space.
19171917
do A=asd,aed ; do i=is,ie
1918-
CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * dt_Angle_size
1918+
CFL_ang(i,j,A) = ((cos_angle(A) * Dl_Dt_Kmag(i)) - (sin_angle(A) * Dk_Dt_Kmag(i))) * dt_Angle_size
19191919
if (abs(CFL_ang(i,j,A)) > 1.0) then
19201920
call MOM_error(WARNING, "refract: CFL exceeds 1.", .true.)
19211921
if (CFL_ang(i,j,A) > 1.0) then ; CFL_ang(i,j,A) = 1.0 ; else ; CFL_ang(i,j,A) = -1.0 ; endif
@@ -2593,7 +2593,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res
25932593

25942594
! Update reflected energy [H Z2 T-2 ~> m3 s-2 or J m-2]
25952595
do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh
2596-
En(i,j,a) = En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))
2596+
En(i,j,a) = En(i,j,a) + (G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a)))
25972597
enddo ; enddo ; enddo
25982598

25992599
end subroutine propagate_x

0 commit comments

Comments
 (0)