Skip to content

Fix compiler warning: "Warning: Fortran 2018 deleted feature: Shared DO termination label" #1484

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

Open
AlysonStahl-NOAA wants to merge 3 commits into
base: develop
Choose a base branch
from
Open

Fix compiler warning: "Warning: Fortran 2018 deleted feature: Shared DO termination label" #1484

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
361e474
remove shared DO in CALWXT.f
AlysonStahl-NOAA Mar 27, 2026
12866fe
remove shared DO termination labels from more files
AlysonStahl-NOAA Mar 27, 2026
962bc70
Update CALWXT_RAMER.f
AlysonStahl-NOAA Mar 27, 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
10 changes: 6 additions & 4 deletions sorc/ncep_post.fd/CALLCL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,8 @@
!> 2002-04-24 | Mike Baldwin | WRF Version
!> 2019-10-30 | Bo Cui | Remove "GOTO" Statement
!> 2021-07-28 | W Meng | Restriction compuatation from undefined grids
!> 2021-09-02 | Bo Cui | Decompose UPP in X direction
!> 2021-09-02 | Bo Cui | Decompose UPP in X direction
!> 2026-03-27 | Alyson Stahl | Remove shared DO termination labels
!>
!> @author Russ Treadon W/NP2 @date 1993-03-15
!-----------------------------------------------------------------------
Expand Down Expand Up @@ -80,8 +81,8 @@ SUBROUTINE CALLCL(P1D,T1D,Q1D,PLCL,ZLCL)
!
! Bo Cui 10/30/2019, remove "GOTO" statement

DO 30 J=JSTA_M,JEND_M
DO 30 I=ISTA_M,IEND_M
DO J=JSTA_M,JEND_M
DO I=ISTA_M,IEND_M
IF(P1D(I,J)<spval.and.Q1D(I,J)<spval)THEN
EVP = P1D(I,J)*Q1D(I,J)/(EPS+ONEPS*Q1D(I,J))
RMX = EPS*EVP/(P1D(I,J)-EVP)
Expand All @@ -103,7 +104,8 @@ SUBROUTINE CALLCL(P1D,T1D,Q1D,PLCL,ZLCL)
ENDIF
20 CONTINUE
ENDIF
30 CONTINUE
ENDDO
ENDDO
!
! END OF ROUTINE.
!
Expand Down
22 changes: 13 additions & 9 deletions sorc/ncep_post.fd/CALWXT.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
! 19-10-30 Bo CUI - REMOVE "GOTO" STATEMENT
! 21-07-26 Wen Meng - Restrict computation from undefined grids
! 21-10-31 JESSE MENG - 2D DECOMPOSITION
! 26-03-27 Alyson Stahl - Remove shared DO termination labels
!
!
! ROUTINE TO COMPUTE PRECIPITATION TYPE USING A DECISION TREE
Expand Down Expand Up @@ -99,8 +100,8 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)

!
!!$omp parallel do private(a,lmhk,pkl,psfck,qkl,tdchk,tdkl,tdpre,tkl)
DO 800 J=JSTA,JEND
DO 800 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
LMHK=NINT(LMH(I,J))
!
! SKIP THIS POINT IF NO PRECIP THIS TIME STEP
Expand Down Expand Up @@ -152,12 +153,13 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
jcontinue=.false.
ENDIF
enddo ! enddo jcontinue
800 CONTINUE
ENDDO
ENDDO
!
! LOWEST LAYER T
!
DO 850 J=JSTA,JEND
DO 850 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
KARR(I,J)=0
IF (PREC(I,J)<=PTHRESH) cycle
LMHK=NINT(LMH(I,J))
Expand Down Expand Up @@ -185,7 +187,8 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
ENDIF
ENDIF
KARR(I,J)=1
850 CONTINUE
ENDDO
ENDDO
!
! COMPUTE WET BULB ONLY AT POINTS THAT NEED IT
!
Expand All @@ -196,8 +199,8 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
! & private(area1,areap4,areas8,dzkl,ifrzl,iwrml,lice, &
! & lmhk,pintk1,pintk2,pm150,psfck,surfc,surfw, &
! & tlmhk,twrmk)
DO 1900 J=JSTA,JEND
DO 1900 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
! IF (I == 324 .AND. J == 390) THEN
! LMHK=NINT(LMH(I,J))
! DO L=LMHK,1,-1
Expand Down Expand Up @@ -313,7 +316,8 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
IWX(I,J)=IWX(I,J)+8
ENDIF
ENDIF
1900 CONTINUE
ENDDO
ENDDO
!---------------------------------------------------------
DEALLOCATE (TWET)

Expand Down
8 changes: 4 additions & 4 deletions sorc/ncep_post.fd/CALWXT_RAMER.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,8 +78,8 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP)
enddo

! BIG LOOP
DO 800 J=JSTA,JEND
DO 800 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
!
! SKIP THIS POINT IF NO PRECIP THIS TIME STEP
!
Expand Down Expand Up @@ -373,8 +373,8 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP)
END IF
IF (trace) WRITE (*,*) "Returned ptyp is:ptyp,lll ", ptyp, lll,'me=',me
IF (trace) WRITE (*,*) "Returned icefrac is: ", icefrac,'me=',me
800 CONTINUE

ENDDO
ENDDO
RETURN
!
END
Expand Down
22 changes: 13 additions & 9 deletions sorc/ncep_post.fd/CALWXT_REVISED.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
! TO MAKE AN ALTERNATE ALGORITHM
! 19-10-30 Bo CUI - REMOVE "GOTO" STATEMENT
! 21-10-31 JESSE MENG - 2D DECOMPOSITION
! 26-03-27 Alyson Stahl - Remove shared DO termination labels
!
!
! ROUTINE TO COMPUTE PRECIPITATION TYPE USING A DECISION TREE
Expand Down Expand Up @@ -88,8 +89,8 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
!
!!$omp parallel do
!!$omp& private(a,lmhk,pkl,psfck,qkl,tdchk,tdkl,tdpre,tkl)
DO 800 J=JSTA,JEND
DO 800 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
LMHK=NINT(LMH(I,J))
!
! SKIP THIS POINT IF NO PRECIP THIS TIME STEP
Expand Down Expand Up @@ -141,12 +142,13 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
jcontinue=.false.
ENDIF
enddo ! enddo jcontinue
800 CONTINUE
ENDDO
ENDDO
!
! LOWEST LAYER T
!
DO 850 J=JSTA,JEND
DO 850 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
KARR(I,J)=0
IF (PREC(I,J)<=PTHRESH) cycle
LMHK=NINT(LMH(I,J))
Expand Down Expand Up @@ -174,7 +176,8 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
ENDIF
ENDIF
KARR(I,J)=1
850 CONTINUE
ENDDO
ENDDO
!
! COMPUTE WET BULB ONLY AT POINTS THAT NEED IT
!
Expand All @@ -184,8 +187,8 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
!!$omp& private(area1,areap4,areap0,areas8,dzkl,ifrzl,iwrml,lice,
!!$omp& lmhk,pintk1,pintk2,pm150,psfck,surfc,surfw,
!!$omp& tlmhk,twrmk)
DO 1900 J=JSTA,JEND
DO 1900 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
IF(KARR(I,J)>0)THEN
LMHK=NINT(LMH(I,J))
LICE=LICEE(I,J)
Expand Down Expand Up @@ -307,7 +310,8 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
IWX(I,J)=IWX(I,J)+8
ENDIF
ENDIF
1900 CONTINUE
ENDDO
ENDDO
! print *, 'revised check ', IWX(500,800)

!---------------------------------------------------------
Expand Down
8 changes: 5 additions & 3 deletions sorc/ncep_post.fd/FRZLVL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@
!> 2019-10-30 | Bo Cui | Remove "GOTO" statement
!> 2020-11-10 | Jesse Meng | Use UPP_PHYSICS module
!> 2021-10-15 |JESSE MENG | 2D DECOMPOSITION
!> 2026-03-27 | Alyson Stahl | Remove shared DO termination labels
!>
!> @author Russ Treadon W/NP2 @date 1992-12-22
!-----------------------------------------------------------------------------
Expand Down Expand Up @@ -80,8 +81,8 @@ SUBROUTINE FRZLVL(ZFRZ,RHFRZ,PFRZL)
! & qsat,qsfc,qsfrz,rhsfc,rhz,tsfc, &
! & zl,zu)

DO 20 J=JSTA,JEND
DO 20 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
HTSFC = FIS(I,J)*GI
LLMH = NINT(LMH(I,J))
RHFRZ(I,J) = D00
Expand Down Expand Up @@ -225,7 +226,8 @@ SUBROUTINE FRZLVL(ZFRZ,RHFRZ,PFRZL)
EXIT
ENDIF
10 CONTINUE
20 CONTINUE
ENDDO
ENDDO
!
! END OF ROUTINE.
!
Expand Down
8 changes: 5 additions & 3 deletions sorc/ncep_post.fd/FRZLVL2.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@
!> 2020-11-10 | Jesse Meng | Use UPP_PHYSICS module
!> 2021-10-15 | JESSE MENG | 2D DECOMPOSITION
!> 2021-07-28 | W. Meng | Restrict compuatation from undefined grids
!> 2026-03-27 | Alyson Stahl | Remove shared DO termination labels
!>
!> @author Russ Treadon W/NP2 @date 1992-12-22
!-------------------------------------------------------------------------------
Expand Down Expand Up @@ -80,8 +81,8 @@ SUBROUTINE FRZLVL2(ISOTHERM,ZFRZ,RHFRZ,PFRZL)
! LOOP OVER HORIZONTAL GRID.
!

DO 20 J=JSTA,JEND
DO 20 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
IF(FIS(I,J)<spval)THEN
HTSFC = FIS(I,J)*GI
LLMH = NINT(LMH(I,J))
Expand Down Expand Up @@ -230,7 +231,8 @@ SUBROUTINE FRZLVL2(ISOTHERM,ZFRZ,RHFRZ,PFRZL)
RHFRZ(I,J) = spval
ZFRZ(I,J) = spval
ENDIF
20 CONTINUE
ENDDO
ENDDO
!
! END OF ROUTINE.
!
Expand Down
8 changes: 5 additions & 3 deletions sorc/ncep_post.fd/LFMFLD.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@
!> 2019-10-30 | Bo Cui | Remove "GOTO" statement
!> 2020-11-10 | Jesse Meng | Use UPP_PHYSICS Module
!> 2021-10-14 | JESSE MENG | 2D DECOMPOSITION
!> 2026-03-27 | Alyson Stahl | Remove shared DO termination labels
!>
!> @author Russ Treadon W/NP2 @date 1992-12-22
!--------------------------------------------------------------------------------------
Expand Down Expand Up @@ -80,8 +81,8 @@ SUBROUTINE LFMFLD(RH3310,RH6610,RH3366,PW3310)
!
! LOOP OVER HORIZONTAL GRID.
!
DO 30 J=JSTA,JEND
DO 30 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
!
! ZERO VARIABLES.
RH3310(I,J) = D00
Expand Down Expand Up @@ -172,7 +173,8 @@ SUBROUTINE LFMFLD(RH3310,RH6610,RH3366,PW3310)
ELSE
RH3366(I,J) = SPVAL
ENDIF
30 CONTINUE
ENDDO
ENDDO
!
!
! END OF ROUTINE.
Expand Down
8 changes: 5 additions & 3 deletions sorc/ncep_post.fd/LFMFLD_GFS.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@
!> 2019-10-30 | Bo Cui | Remove "GOTO" statement
!> 2020-11-10 | Jesse Meng | Use UPP_PHYSICS Module
!> 2021-10-14 | JESSE MENG | 2D DECOMPOSITION
!> 2026-03-27 | Alyson Stahl | Remove shared DO termination labels
!>
!> @author Russ Treadon W/NP2 @date 1992-12-22
!---------------------------------------------------------------------------
Expand Down Expand Up @@ -87,8 +88,8 @@ SUBROUTINE LFMFLD_GFS(RH4410,RH7294,RH4472,RH3310)
!
! LOOP OVER HORIZONTAL GRID.
!
DO 30 J=JSTA,JEND
DO 30 I=ISTA,IEND
DO J=JSTA,JEND
DO I=ISTA,IEND
!
! ZERO VARIABLES.
RH4410(I,J) = D00
Expand Down Expand Up @@ -194,7 +195,8 @@ SUBROUTINE LFMFLD_GFS(RH4410,RH7294,RH4472,RH3310)
ELSE
RH7294(I,J) = SPVAL
ENDIF
30 CONTINUE
ENDDO
ENDDO
!
! END OF ROUTINE.
!
Expand Down
15 changes: 9 additions & 6 deletions sorc/ncep_post.fd/MDL2AGL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@
!! 2023-03-02 S TRAHAN - copy lightning threat index 3 element-by-element
!! 2023-10-23 J Kenyon - HAILCAST output enabled in RRFS
!! 2025-04-01 W Meng - Bug fix in HAILCAST
!! 2026-03-27 A Stahl - Remove shared DO termination labels
!!
!! USAGE: CALL MDL2P
!! INPUT ARGUMENT LIST:
Expand Down Expand Up @@ -1037,8 +1038,8 @@ SUBROUTINE MDL2AGL
call exch(VH(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,LL))
END DO
END IF
DO 230 J=JSTART,JSTOP
DO 230 I=ISTART,ISTOP
DO J=JSTART,JSTOP
DO I=ISTART,ISTOP
LL=NL1X(I,J)
!---------------------------------------------------------------------
!*** VERTICAL INTERPOLATION OF GEOPOTENTIAL, TEMPERATURE, SPECIFIC
Expand Down Expand Up @@ -1128,7 +1129,8 @@ SUBROUTINE MDL2AGL
& VH(IE,JS,NINT(LMV(IE,JS)))+VH(IW,JS,NINT(LMV(IW,JS))))/4.0
END IF
END IF
230 CONTINUE
ENDDO
ENDDO
!
!
!---------------------------------------------------------------------
Expand Down Expand Up @@ -1238,8 +1240,8 @@ SUBROUTINE MDL2AGL
!chc I=IHOLD(NN)
!chc J=JHOLD(NN)
! DO 220 J=JSTA,JEND
DO 240 J=JSTA_2L,JEND_2U
DO 240 I=ISTA_2L,IEND_2U
DO J=JSTA_2L,JEND_2U
DO I=ISTA_2L,IEND_2U
LL = NL1X(I,J)
!---------------------------------------------------------------------
!*** VERTICAL INTERPOLATION OF GEOPOTENTIAL, TEMPERATURE, SPECIFIC
Expand Down Expand Up @@ -1295,7 +1297,8 @@ SUBROUTINE MDL2AGL
UAGL(I,J) = UH(I,J,NINT(LMV(I,J)))
VAGL(I,J) = VH(I,J,NINT(LMV(I,J)))
END IF
240 CONTINUE
ENDDO
ENDDO
!
!
!---------------------------------------------------------------------
Expand Down
Loading
Loading