diff --git a/driver/UFS/fv_processmodel.F90 b/driver/UFS/fv_processmodel.F90 index 9cfb91ad..6104e44a 100644 --- a/driver/UFS/fv_processmodel.F90 +++ b/driver/UFS/fv_processmodel.F90 @@ -882,7 +882,7 @@ subroutine SuperCell_Sounding(km, ps, pk1, tp, qp) enddo ! Interpolate to p levels using pk1: p**kappa - do 555 k=1, km + do k=1, km if ( pk1(k) .le. pk(1) ) then tp(k) = pt(1)*pk(1)/pk1(k) ! isothermal above qp(k) = qst ! set to stratosphere value @@ -895,11 +895,11 @@ subroutine SuperCell_Sounding(km, ps, pk1, tp, qp) fac_z = (pk1(k)-pk(kk))/(pk(kk+1)-pk(kk)) tp(k) = pt(kk) + (pt(kk+1)-pt(kk))*fac_z qp(k) = qs(kk) + (qs(kk+1)-qs(kk))*fac_z - goto 555 + exit endif enddo endif - 555 continue + enddo do k=1,km tp(k) = tp(k)*pk1(k) ! temperature diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index 10124fb8..db0e4ea9 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -1022,7 +1022,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, call range_check('VA_dyn', ua, is, ie, js, je, ng, npz,gridstruct%agrid,& -880., 880., bad_range) call range_check('TA_dyn', pt, is, ie, js, je, ng, npz,gridstruct%agrid,& - 150.,3350., bad_range) + 50.,335., bad_range) call range_check('W_dyn', w, is, ie, js, je, ng, npz,gridstruct%agrid, & -250., 250., bad_range) else @@ -1031,7 +1031,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, call range_check('VA_dyn', ua, is, ie, js, je, ng, npz, gridstruct%agrid, & -280., 280., bad_range, fv_time) call range_check('TA_dyn', pt, is, ie, js, je, ng, npz, gridstruct%agrid, & - 150., 335., bad_range, fv_time) + 50., 335., bad_range, fv_time) if ( .not. hydrostatic ) & call range_check('W_dyn', w, is, ie, js, je, ng, npz, gridstruct%agrid, & -50., 100., bad_range, fv_time) diff --git a/model/nh_utils.F90 b/model/nh_utils.F90 index d2895f16..cad5d6f1 100644 --- a/model/nh_utils.F90 +++ b/model/nh_utils.F90 @@ -924,15 +924,13 @@ subroutine RIM_2D(ms, bdt, is, ie, km, rgas, gama, gm2, & r_hi(k) = wm(k) - ptmp1 enddo - ktop = ks1 + ktop = km ! Default value if dt is not .gt. dts(k) do k=ks1, km if( dt > dts(k) ) then ktop = k-1 - goto 333 + exit endif enddo - ktop = km -333 continue if ( ktop >= ks1 ) then do k=ks1, ktop @@ -951,7 +949,7 @@ subroutine RIM_2D(ms, bdt, is, ie, km, rgas, gama, gm2, & enddo kt1 = max(1, ktop) - do 444 ke=km+1, ktop+2, -1 + do ke=km+1, ktop+2, -1 time_left = dt do k=ke-1, kt1, -1 if ( time_left > dts(k) ) then @@ -962,10 +960,10 @@ subroutine RIM_2D(ms, bdt, is, ie, km, rgas, gama, gm2, & z_frac = time_left/dts(k) m_top(ke) = m_top(ke) + z_frac*dm(k) r_top(ke) = r_top(ke) + z_frac*r_hi(k) - go to 444 ! next level + exit endif enddo -444 continue + enddo do k=ktop+1, km m_bot(k) = 0. diff --git a/model/tp_core.F90 b/model/tp_core.F90 index f095d79e..c7917d24 100644 --- a/model/tp_core.F90 +++ b/model/tp_core.F90 @@ -364,7 +364,7 @@ subroutine xppm(flux, q, c, iord, is,ie,isd,ied, jfirst,jlast,jsd,jed, npx, npy, mord = abs(iord) - do 666 j=jfirst,jlast + do j=jfirst,jlast do i=isd, ied q1(i) = q(i,j) @@ -551,7 +551,7 @@ subroutine xppm(flux, q, c, iord, is,ie,isd,ied, jfirst,jlast,jsd,jed, npx, npy, enddo endif - goto 666 + cycle else @@ -699,8 +699,7 @@ subroutine xppm(flux, q, c, iord, is,ie,isd,ied, jfirst,jlast,jsd,jed, npx, npy, endif enddo endif - -666 continue + enddo end subroutine xppm diff --git a/tools/test_cases.F90 b/tools/test_cases.F90 index 306a8e62..461e4518 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -5585,10 +5585,9 @@ subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe, enddo ! k = km+1 ! pk(i,j,k) = pk2(jj,k) + fac_y*(pk2(jj+1,k)-pk2(jj,k)) - goto 123 + exit endif enddo -123 continue enddo enddo @@ -5761,7 +5760,7 @@ subroutine SuperCell_Sounding(km, ps, pk1, tp, qp) enddo ! Interpolate to p levels using pk1: p**kappa - do 555 k=1, km + do k=1, km if ( pk1(k) .le. pk(1) ) then tp(k) = pt(1)*pk(1)/pk1(k) ! isothermal above qp(k) = qst ! set to stratosphere value @@ -5774,11 +5773,11 @@ subroutine SuperCell_Sounding(km, ps, pk1, tp, qp) fac_z = (pk1(k)-pk(kk))/(pk(kk+1)-pk(kk)) tp(k) = pt(kk) + (pt(kk+1)-pt(kk))*fac_z qp(k) = qs(kk) + (qs(kk+1)-qs(kk))*fac_z - goto 555 + exit endif enddo endif -555 continue + enddo do k=1,km tp(k) = tp(k)*pk1(k) ! temperature