From fa46540444749d14c5054828ec658ec6e6080654 Mon Sep 17 00:00:00 2001
From: "samuel.trahan" <Samuel.Trahan@noaa.gov>
Date: Thu, 1 Sep 2022 22:18:53 +0000
Subject: [PATCH 1/2] Fix out-of-bounds accesses and modernize some line-number
 do loops

---
 sorc/ncep_post.fd/MDL2SIGMA.f   | 12 ++++++++----
 sorc/ncep_post.fd/MISCLN.f      | 12 ++++++------
 sorc/ncep_post.fd/UPP_PHYSICS.f |  3 +++
 3 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/sorc/ncep_post.fd/MDL2SIGMA.f b/sorc/ncep_post.fd/MDL2SIGMA.f
index e2fd97a36..110600ea4 100644
--- a/sorc/ncep_post.fd/MDL2SIGMA.f
+++ b/sorc/ncep_post.fd/MDL2SIGMA.f
@@ -277,8 +277,9 @@ SUBROUTINE MDL2SIGMA
            AHF  =D00
            FAC  =D00
 	   DONEFSL1=.TRUE.
-         ELSEIF(T(I,J,NL1XF(I,J))<SPVAL                 &
-     &	 .AND. Q(I,J,NL1XF(I,J))<SPVAL)THEN
+         ELSEIF(NL1XF(I,J)<LP1) THEN
+          IF(T(I,J,NL1XF(I,J))<SPVAL                 &
+     &	   .AND. Q(I,J,NL1XF(I,J))<SPVAL)THEN
 !==        B     =T(I,J,NL1XF(I,J)) !Marina Tsidulko Dec22, 2003
            B     =T(I,J,NL1XF(I,J))*(H1+D608*Q(I,J,NL1XF(I,J)))
            DENOM=(ALPINT(I,J,NL1XF(I,J)+1)-ALPINT(I,J,NL1XF(I,J)-1))
@@ -287,6 +288,7 @@ SUBROUTINE MDL2SIGMA
                    /DENOM            !Marina Tsidulko Dec22, 2003
            FAC =H2*LOG(PMID(I,J,NL1XF(I,J)))
 	   DONEFSL1=.TRUE.
+          END IF
          END IF
 !
          if(DONEFSL1)FSL1(I,J)=(PNL1-PFSIGO)/(PFSIGO+PNL1)              &
@@ -656,8 +658,9 @@ SUBROUTINE MDL2SIGMA
 	      TSLDONE=.TRUE.
 !
 !
-            ELSEIF(T(I,J,NL1XF(I,J))<SPVAL              &
-     &	 .AND. Q(I,J,NL1XF(I,J))<SPVAL)THEN
+            ELSEIF(NL1XF(I,J)<LP1) THEN
+             IF(T(I,J,NL1XF(I,J))<SPVAL              &
+     &	  .AND. Q(I,J,NL1XF(I,J))<SPVAL)THEN
 !
 !           INTERPOLATION BETWEEN LOWER AND UPPER BOUNDS.
 !
@@ -674,6 +677,7 @@ SUBROUTINE MDL2SIGMA
                    /DENOMF             !Marina Tsidulko Dec22, 2003
 !
               DONEFSL1=.TRUE.     
+             ENDIF
             ENDIF   
 !
             IF(DONEFSL1)then
diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f
index 84417aaf2..34a58a041 100644
--- a/sorc/ncep_post.fd/MISCLN.f
+++ b/sorc/ncep_post.fd/MISCLN.f
@@ -860,7 +860,7 @@ SUBROUTINE MISCLN
 
          CALL FDLVL(ITYPEFDLVL,T7D,Q7D,U7D,V6D,P7D,ICINGFD,AERFD)
 !     
-         DO 10 IFD = 1,NFD
+         loop_10: DO IFD = 1,NFD
 !
 !           FD LEVEL TEMPERATURE.
             iget1 = IGET(059)
@@ -1328,7 +1328,7 @@ SUBROUTINE MISCLN
                ENDIF
             ENDIF
 
- 10      CONTINUE
+         END DO loop_10
          DEALLOCATE(T7D,Q7D,U7D,V6D,P7D,ICINGFD,AERFD)
       ENDIF
 
@@ -1807,7 +1807,7 @@ SUBROUTINE MISCLN
 
 !     
 !        LOOP OVER NBND BOUNDARY LAYERS.
-         DO 20 LBND = 1,NBND
+         boundary_layer_loop: DO LBND = 1,NBND
 !     
 !           BOUNDARY LAYER PRESSURE.
             IF (IGET(067)>0) THEN
@@ -2118,7 +2118,7 @@ SUBROUTINE MISCLN
             ENDIF
 !
 !        END OF ETA BOUNDARY LAYER LOOP.
- 20      CONTINUE
+         END DO boundary_layer_loop
          deallocate(OMGBND,PWTBND,QCNVBND)
 !     
 !        BEST LIFTED INDEX FROM BOUNDARY LAYER FIELDS.
@@ -2208,7 +2208,7 @@ SUBROUTINE MISCLN
              ENDDO
            ENDDO
 !
-           DO 80 LBND = 1,NBND
+           loop_80: DO LBND = 1,NBND
            CALL CALTHTE(PBND(ista,jsta,LBND),TBND(ista,jsta,LBND),        &
                         QBND(ista,jsta,LBND),EGRID1)
 !$omp parallel do private(i,j)
@@ -2223,7 +2223,7 @@ SUBROUTINE MISCLN
                ENDIF
              ENDDO
            ENDDO
- 80        CONTINUE
+           ENDDO loop_80
 !
            DPBND = 0.
            CALL CALCAPE(ITYPE,DPBND,P1D,T1D,Q1D,LB2,EGRID1,   &
diff --git a/sorc/ncep_post.fd/UPP_PHYSICS.f b/sorc/ncep_post.fd/UPP_PHYSICS.f
index cc6bd7c5e..7c0cb053f 100644
--- a/sorc/ncep_post.fd/UPP_PHYSICS.f
+++ b/sorc/ncep_post.fd/UPP_PHYSICS.f
@@ -1320,6 +1320,9 @@ SUBROUTINE CALCAPE2(ITYPE,DPBND,P1D,T1D,Q1D,L1D,    &
               THUNDER(I,J) = .FALSE.
             ENDIF
           ENDIF
+
+          ! Limit LCL to prevent out-of-bounds accesses later
+          LCL(I,J) = max(min(LCL(I,J),LM-1),1)
         ENDDO
       ENDDO
 !-----------------------------------------------------------------------

From 0c0466827f69b76375bb15754036050286679e22 Mon Sep 17 00:00:00 2001
From: "samuel.trahan" <Samuel.Trahan@noaa.gov>
Date: Fri, 2 Sep 2022 10:06:59 +0000
Subject: [PATCH 2/2] add comments

---
 sorc/ncep_post.fd/MDL2SIGMA.f   | 5 +++--
 sorc/ncep_post.fd/UPP_PHYSICS.f | 1 +
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/sorc/ncep_post.fd/MDL2SIGMA.f b/sorc/ncep_post.fd/MDL2SIGMA.f
index 110600ea4..6dcb2654e 100644
--- a/sorc/ncep_post.fd/MDL2SIGMA.f
+++ b/sorc/ncep_post.fd/MDL2SIGMA.f
@@ -21,6 +21,7 @@
 !!   20-03-25  J MENG - remove grib1
 !!   21-03-11  B Cui - change local arrays to dimension (im,jsta:jend)
 !!   21-10-14  J MENG - 2D DECOMPOSITION
+!!   2022-09-01 S Trahan - fixed bugs where extreme atmospheric conditions can cause out-of-bounds access
 !!  
 !! USAGE:    CALL MDL2P
 !!   INPUT ARGUMENT LIST:
@@ -277,7 +278,7 @@ SUBROUTINE MDL2SIGMA
            AHF  =D00
            FAC  =D00
 	   DONEFSL1=.TRUE.
-         ELSEIF(NL1XF(I,J)<LP1) THEN
+         ELSEIF(NL1XF(I,J)<LP1) THEN ! must check the "<LP1" first; do not combine these into a single "if"
           IF(T(I,J,NL1XF(I,J))<SPVAL                 &
      &	   .AND. Q(I,J,NL1XF(I,J))<SPVAL)THEN
 !==        B     =T(I,J,NL1XF(I,J)) !Marina Tsidulko Dec22, 2003
@@ -658,7 +659,7 @@ SUBROUTINE MDL2SIGMA
 	      TSLDONE=.TRUE.
 !
 !
-            ELSEIF(NL1XF(I,J)<LP1) THEN
+            ELSEIF(NL1XF(I,J)<LP1) THEN ! must check the "<LP1" first; do not combine these into a single "if"
              IF(T(I,J,NL1XF(I,J))<SPVAL              &
      &	  .AND. Q(I,J,NL1XF(I,J))<SPVAL)THEN
 !
diff --git a/sorc/ncep_post.fd/UPP_PHYSICS.f b/sorc/ncep_post.fd/UPP_PHYSICS.f
index 7c0cb053f..cb059ba1f 100644
--- a/sorc/ncep_post.fd/UPP_PHYSICS.f
+++ b/sorc/ncep_post.fd/UPP_PHYSICS.f
@@ -999,6 +999,7 @@ END SUBROUTINE CALCAPE
 !> 2021-09-03 | J Meng        | Modified to add 0-3km CAPE/CINS, LFC, effective helicity, downdraft CAPE, dendritic growth layer depth, ESP
 !> 2021-09-01 | E Colon       | Equivalent level height index for RTMA
 !> 2022-08-27 | S Trahan      | Fixed bug in CALCAPE2 where extreme atmospheric conditions cause an out-of-bounds access
+!> 2022-09-01 | S Trahan      | Fixed another bug in CALCAPE2 where extreme atmospheric conditions cause an out-of-bounds access
 !>
 !> @author Russ Treadon W/NP2 @date 1993-02-10
       SUBROUTINE CALCAPE2(ITYPE,DPBND,P1D,T1D,Q1D,L1D,    &