Skip to content

[production/GFS.v17] Reduce number of goto statements and fix RRTMGP warning #370

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
rhaesung merged 2 commits into from
Apr 8, 2026
Merged

[production/GFS.v17] Reduce number of goto statements and fix RRTMGP warning #370

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ed9827f
Production goto removals from ccpp-physics PR #367
dpsarmie Apr 7, 2026
7703e5f
Update hash to rrtmgp production
dpsarmie Apr 7, 2026
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
2 changes: 1 addition & 1 deletion .gitmodules
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"]
path = physics/Radiation/RRTMGP/rte-rrtmgp
url = https://github.com/NCAR/rte-rrtmgp
branch = main
branch = production/GFS.v17
[submodule "physics/MP/TEMPO/TEMPO"]
path = physics/MP/TEMPO/TEMPO
url = https://github.com/NCAR/TEMPO
Expand Down
11 changes: 5 additions & 6 deletions physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2837,7 +2837,7 @@ subroutine lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, q, precip, m1, mono)

k0 = ktop
do k = ktop, kbot
do n = k0, kbot
n_loop: do n = k0, kbot
if (ze (k) <= zt (n) .and. ze (k) >= zt (n + 1)) then
pl = (zt (n) - ze (k)) / dz (n)
if (zt (n + 1) <= ze (k + 1)) then
Expand All @@ -2847,7 +2847,7 @@ subroutine lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, q, precip, m1, mono)
a4 (4, n) * r3 * (pr * (pr + pl) + pl ** 2)
qm (k) = qm (k) * (ze (k) - ze (k + 1))
k0 = n
goto 555
exit n_loop
else
qm (k) = (ze (k) - zt (n + 1)) * (a4 (2, n) + 0.5 * (a4 (4, n) + &
a4 (3, n) - a4 (2, n)) * (1. + pl) - a4 (4, n) * (r3 * (1. + pl * (1. + pl))))
Expand All @@ -2862,15 +2862,14 @@ subroutine lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, q, precip, m1, mono)
qm (k) = qm (k) + delz * (a4 (2, m) + 0.5 * esl * &
(a4 (3, m) - a4 (2, m) + a4 (4, m) * (1. - r23 * esl)))
k0 = m
goto 555
exit n_loop
endif
enddo
endif
goto 555
exit n_loop
endif
endif
enddo
555 continue
enddo n_loop
enddo

m1 (ktop) = q (ktop) - qm (ktop)
Expand Down
11 changes: 5 additions & 6 deletions physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4542,7 +4542,7 @@ subroutine lagrangian_fall (ks, ke, zs, ze, zt, dp, q, precip, m1)

k0 = ks
do k = ks, ke
do n = k0, ke
n_loop: do n = k0, ke
if (ze (k) .le. zt (n) .and. ze (k) .ge. zt (n + 1)) then
pl = (zt (n) - ze (k)) / dz (n)
if (zt (n + 1) .le. ze (k + 1)) then
Expand All @@ -4552,7 +4552,7 @@ subroutine lagrangian_fall (ks, ke, zs, ze, zt, dp, q, precip, m1)
a4 (4, n) * r3 * (pr * (pr + pl) + pl ** 2)
qm (k) = qm (k) * (ze (k) - ze (k + 1))
k0 = n
goto 555
exit n_loop
else
qm (k) = (ze (k) - zt (n + 1)) * (a4 (2, n) + 0.5 * (a4 (4, n) + &
a4 (3, n) - a4 (2, n)) * (1. + pl) - a4 (4, n) * (r3 * (1. + pl * (1. + pl))))
Expand All @@ -4567,15 +4567,14 @@ subroutine lagrangian_fall (ks, ke, zs, ze, zt, dp, q, precip, m1)
qm (k) = qm (k) + delz * (a4 (2, m) + 0.5 * esl * &
(a4 (3, m) - a4 (2, m) + a4 (4, m) * (1. - r23 * esl)))
k0 = m
goto 555
exit n_loop
endif
enddo
endif
goto 555
exit n_loop
endif
endif
enddo
555 continue
enddo n_loop
enddo

m1 (ks) = q (ks) - qm (ks)
Expand Down
96 changes: 44 additions & 52 deletions physics/MP/Morrison_Gettelman/aer_cloud.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1543,7 +1543,7 @@ subroutine activate (wparc,ndroplet,smax,nmodes,
!
! *** perform bisection *************************************************
!
20 do 30 i=1,maxit_par
do i=1,maxit_par
x3 = 0.5*(x1+x2)
!
if (ntot .gt. zero_par) then
Expand All @@ -1562,15 +1562,15 @@ subroutine activate (wparc,ndroplet,smax,nmodes,
x1 = x3
endif
!
if (abs(x2-x1) .le. eps_par*x1) goto 40
if (abs(x2-x1) .le. eps_par*x1) exit
niter = i


30 continue
end do
!
! *** converged ; return ************************************************
!
40 x3 = 0.5*(x1+x2)
x3 = 0.5*(x1+x2)
!
if (ntot .gt. zero_par) then
call sintegral (x2,ndrpl,sinteg1,sinteg2,wparcel,nmodes,
Expand Down Expand Up @@ -1826,25 +1826,29 @@ subroutine gauleg (x,w,n)
m=(n+1)/2d0
xm=0.5d0*(x2+x1)
xl=0.5d0*(x2-x1)
do 12 i=1,m

do i=1,m
z=cos(pi_par*(i-.25d0)/(n+.5d0))
1 continue
do
p1=1.d0
p2=0.d0
do 11 j=1,n
p3=p2
p2=p1
p1=((2.d0*j-1.)*z*p2-(j-1.d0)*p3)/j
11 continue
do j=1,n
p3=p2
p2=p1
p1=((2.d0*j-1.)*z*p2-(j-1.d0)*p3)/j
end do

pp=n*(z*p1-p2)/(z*z-1.d0)
z1=z
z=z1-p1/pp
if(abs(z-z1).gt.eps_par)go to 1
if(abs(z-z1).gt.eps_par) exit
end do

x(i)=xm-xl*z
x(n+1-i)=xm+xl*z
w(i)=2.d0*xl/((1.d0-z*z)*pp*pp)
w(n+1-i)=w(i)
12 continue
end do
end subroutine gauleg

!C=======================================================================
Expand Down Expand Up @@ -2922,28 +2926,22 @@ real*8 function cubicint_ice(y, y1, y2, a, b)
real*8 :: A_, B_, a0, a1, a2, a3, d, AUX

if (y .le. y1) then
d=a
goto 5065
end if

if (y .ge. y2) then
d=b
goto 5065
end if


AUX=y2-y1
A_=6d0*(a-b)/(AUX*AUX*AUX)
B_=a+(A_*(y1*y1*y1)/6d0)-(A_*(y1*y1)*y2*0.5d0)

a0=B_
a1=A_*y1*y2
a2=-A_*(y1+y2)*0.5d0
a3=A_/3d0
d=a0+(a1*y)+(a2*y*y)+(a3*y*y*y)

d=a
elseif (y .ge. y2) then
d=b
else
AUX=y2-y1
A_=6d0*(a-b)/(AUX*AUX*AUX)
B_=a+(A_*(y1*y1*y1)/6d0)-(A_*(y1*y1)*y2*0.5d0)

a0=B_
a1=A_*y1*y2
a2=-A_*(y1+y2)*0.5d0
a3=A_/3d0
d=a0+(a1*y)+(a2*y*y)+(a3*y*y*y)
endif

5065 cubicint_ice=d
cubicint_ice=d


end function cubicint_ice
Expand All @@ -2958,26 +2956,20 @@ real*8 function dcubicint_ice(y, y1, y2, a, b)
real*8 :: A_, a0, a1, a2, a3, d, AUX

if (y .le. y1) then
d=0
goto 5065
end if

if (y .ge. y2) then
d=0
goto 5065
end if


AUX=y2-y1
A_=6d0*(a-b)/(AUX*AUX*AUX)

a1=A_*y1*y2
a2=-A_*(y1+y2)*0.5d0
a3=A_/3d0
d=(a1)+(2d0*a2*y)+(3d0*a3*y*y)
d=0
elseif (y .ge. y2) then
d=0
else
AUX=y2-y1
A_=6d0*(a-b)/(AUX*AUX*AUX)

a1=A_*y1*y2
a2=-A_*(y1+y2)*0.5d0
a3=A_/3d0
d=(a1)+(2d0*a2*y)+(3d0*a3*y*y)
endif

5065 dcubicint_ice=d
dcubicint_ice=d


end function dcubicint_ice
Expand Down
17 changes: 9 additions & 8 deletions physics/MP/Morrison_Gettelman/cldwat2m_micro.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4745,11 +4745,10 @@ subroutine findsp1 (lchnk, ncol, q, t, p, tsp, qsp)
end do

if (dtm < dttol .and. dqm < dqtol) then
go to 10
exit
endif

end do
10 continue

error_found = .false.
if (dtm > dttol .or. dqm > dqtol) then
Expand Down Expand Up @@ -5023,11 +5022,10 @@ subroutine findsp1_water (lchnk, ncol, q, t, p, tsp, qsp)
end do

if (dtm < dttol .and. dqm < dqtol) then
go to 10
exit
endif

end do
10 continue

error_found = .false.
if (dtm > dttol .or. dqm > dqtol) then
Expand Down Expand Up @@ -5439,7 +5437,8 @@ FUNCTION GAMMA(X)
Y = Y + ONE
ELSE
RES=XINF
GOTO 900
GAMMA = RES
RETURN
ENDIF
ENDIF
!----------------------------------------------------------------------
Expand All @@ -5453,7 +5452,8 @@ FUNCTION GAMMA(X)
RES = ONE/Y
ELSE
RES = XINF
GOTO 900
GAMMA = RES
RETURN
ENDIF
ELSEIF(Y.LT.TWELVE)THEN
Y1 = Y
Expand Down Expand Up @@ -5510,15 +5510,16 @@ FUNCTION GAMMA(X)
RES = EXP(SUM)
ELSE
RES = XINF
GOTO 900
GAMMA = RES
RETURN
ENDIF
ENDIF
!----------------------------------------------------------------------
! FINAL ADJUSTMENTS AND RETURN
!----------------------------------------------------------------------
IF(PARITY) RES = -RES
IF(FACT.NE.ONE) RES = FACT/RES
900 GAMMA = RES
GAMMA = RES
!D900 DGAMMA = RES
RETURN
! ---------- LAST LINE OF GAMMA ----------
Expand Down
Loading
Loading