      SUBROUTINE LAKE_CATCHMENT1(DEM,PP,QQ,MARKY,CMARK,CATCH_FLAG,OUT_I,
     &OUT_J,K1,K2,K3,K4,ROWS,COLS,SX,RUNOFF)

      ! THIS SUBROUTINE DELINEATES THE CATCHMENT FOR A LAKE

      ! DESCRIPTION OF VARIABLES:

      ! DEM: CONTAINS DEM SURFACE ELEVATION (IN METERS) FOR EVERY GRID
      ! CELL. REMAINS UNMODIFIED IN THIS SUBROUTINE

      ! OUT_I,OUT_J: STORES THE COORDINATES OF CATCHMENT OUTLET. GETS
      ! MODIFIED IN THIS SUBROUTINE

      ! CMARK: SHOWS 1 FOR CREVASSED CELL AND 0 FOR NON CREVASSED CELL.
      ! UPDATED EVERY TIMESTEP IN THE CREV_CELLS1.F SUBROUTINE. REMAINS
      ! UNMODIFIED IN THIS SUBROUTINE

      ! ROWS,COLS: ROWS AND COLUMNS OF THE STUDY AREA. REMAINS
      ! UNMODIFIED IN THIS SUBROUTINE

      ! SX: CONSTANT

      ! RUNOFF: CONTAINS RUNOFF MELTWATER (IN METERS) FOR EVERY GRID
      ! CELL. REMAINS UNMODIFIED IN THIS SUBROUTINE

      ! K1,K2,K3,K4: STORES THE EXTENT OF THE LAKE CATCHMENT. GETS MODIFIED
      ! IN THIS SUBROUTINE

      ! PP,QQ: STORES THE COORDINATES OF THE LAKE NUCLEUS. REMAINS
      ! UNMODIFIED IN THIS SUBROUTINE

      ! MARKY: STORES THE DELINEATED LAKE. SHOWS 1 FOR LAKE PIXELS AND 0
      ! OTHERWISE. REMAINS UNMODIFIED IN THIS SUBROUTINE

      IMPLICIT NONE

      INTEGER :: SX,P,COUNTP,ROWS,COLS,K1,K2,K3,K4,PP,QQ,XIND(SX),
     &YIND(SX),XF(SX),YF(SX),I1,J1,S,K,NN,COUNTY,COUNTZ,II(9),
     &JJ(9),A,B,N,ICLOW,MARKY(COLS,ROWS),NUM1,KK,CATCH_FLAG(COLS,ROWS),
     &CMARK(COLS,ROWS),VAL1(9),TEMP_XF,TEMP_YF,MM,OUT_I,OUT_J,
     &INDI(2),TEMP_II,III(9)

      DOUBLE PRECISION :: VALS(9),DEM(COLS,ROWS),LOW,SURF_CATCH(SX),
     &TEMP_SURF,RUNOFF(COLS,ROWS)

      ! FINDING THE CORNERS OF THE SEARCH BOX WHICH WILL BE A 200 BY 200
      ! BOX CENTERED AROUND THE LAKE NUCLEUS

      P=100
      COUNTP=1
      DO WHILE ((P.GE.0).AND.(COUNTP.EQ.1))
      IF ((PP-P).GE.2) THEN
              K1=P
              COUNTP=0
      ELSE
              P=P-1
              COUNTP=1
      END IF
      END DO

      P=100
      COUNTP=1
      DO WHILE ((P.GE.0).AND.(COUNTP.EQ.1))
      IF ((PP+P).LE.COLS-1) THEN
              K2=P
              COUNTP=0
      ELSE
              P=P-1
              COUNTP=1
      END IF
      END DO

      P=100
      COUNTP=1
      DO WHILE ((P.GE.0).AND.(COUNTP.EQ.1))
      IF ((QQ-P).GE.2) THEN
              K3=P
              COUNTP=0
      ELSE
              P=P-1
              COUNTP=1
      END IF
      END DO

      P=100
      COUNTP=1
      DO WHILE ((P.GE.0).AND.(COUNTP.EQ.1))
      IF ((QQ+P).LE.ROWS-1) THEN
              K4=P
              COUNTP=0
      ELSE
              P=P-1
              COUNTP=1
      END IF
      END DO

      XIND=XIND-XIND
      YIND=YIND-YIND
      SURF_CATCH=SURF_CATCH-SURF_CATCH
      XF=XF-XF
      YF=YF-YF

      ! DELINEATING THE CATCHMENT WITHIN THE SEARCH BOX CENTERED AROUND
      ! THE LAKE NUCLEUS. ALL THE DEM CELLS THAT CAN POTENTIALLY
      ! CONTRIBUTE MELTWATER RUNOFF TO THE LAKE, FORM A PART OF THE LAKE
      ! CATCHMENT

      DO 100 I1=PP-K1,PP+K2
      DO 110 J1=QQ-K3,QQ+K4
      S=I1
      K=J1
      NN=1
      COUNTY=1
      COUNTZ=1
      XIND=XIND-XIND
      YIND=YIND-YIND
      XF=XF-XF
      YF=YF-YF

      DO WHILE ((NN.EQ.1).AND.(S.LE.COLS-1).AND.(K.LE.ROWS-1).AND.
     &(S.GE.2).AND.(K.GE.2))

      IF (COUNTZ.EQ.1) THEN
              XIND(COUNTY)=S
              YIND(COUNTY)=K
              COUNTY=COUNTY+1
              COUNTZ=COUNTZ+1
      END IF

      II=(/S-1,S-1,S-1,S,S,S,S+1,S+1,S+1/)
      JJ=(/K-1,K,K+1,K-1,K,K+1,K-1,K,K+1/)

      DO 120 N=1,9
      A=II(N)
      B=JJ(N)
      VALS(N)=DEM(A,B)
120   CONTINUE

      ICLOW=0
      LOW=999999

      DO 130 N=1,9
      IF (VALS(N).LT.LOW) THEN
              ICLOW=N
              LOW=VALS(N)
      END IF
130   CONTINUE

      IF (VALS(5).EQ.LOW) THEN
              NN=0
              S=II(5)
              K=JJ(5)
      ELSE
              S=II(ICLOW)
              K=JJ(ICLOW)
              NN=1
              XIND(COUNTY)=S
              YIND(COUNTY)=K
              COUNTY=COUNTY+1
      END IF

      END DO

      ! ALL THE CELLS THAT END UP IN THE LAKE ARE PART OF THE CATCHMENT

      IF (MARKY(S,K).EQ.1) THEN
              NUM1=COUNT(XIND.NE.0)
              DO 140 KK=1,NUM1
              A=XIND(KK)
              B=YIND(KK)
              IF ((A.NE.0).AND.(B.NE.0)) THEN
                      CATCH_FLAG(A,B)=1
              ELSE
                      CATCH_FLAG(A,B)=0
              END IF
140           CONTINUE
      ELSE
      END IF
110   CONTINUE
100   CONTINUE

      COUNTY=1

      ! LOCATING THE OUTLET CELL OF THE CATCHMENT

      IF (SUM(CATCH_FLAG,MASK=CATCH_FLAG.EQ.1).GT.1) THEN
              DO 150 I1=PP-K1,PP+K2
              DO 160 J1=QQ-K3,QQ+K4
              IF (CATCH_FLAG(I1,J1).EQ.1) THEN
                      II=(/I1-1,I1-1,I1-1,I1,I1,I1,I1+1,I1+1,I1+1/)
                      JJ=(/J1-1,J1,J1+1,J1-1,J1,J1+1,J1-1,J1,J1+1/)

                      DO 170 N=1,9
                      A=II(N)
                      B=JJ(N)
                      VAL1(N)=CATCH_FLAG(A,B)
170                   CONTINUE

                      IF (((VAL1(1).EQ.0).OR.(VAL1(2).EQ.0).OR.
     &(VAL1(3).EQ.0).OR.(VAL1(4).EQ.0).OR.(VAL1(6).EQ.0).OR.
     &(VAL1(7).EQ.0).OR.(VAL1(8).EQ.0).OR.(VAL1(9).EQ.0)).AND.
     &(VAL1(5).EQ.1)) THEN
                      A=II(5)
                      B=JJ(5)
                      XF(COUNTY)=A
                      YF(COUNTY)=B
                      SURF_CATCH(COUNTY)=DEM(A,B)
                      COUNTY=COUNTY+1 ! BOUNDARY CELLS OF CATCHMENT
                      END IF
              END IF
160           CONTINUE
150           CONTINUE

              ! SORTING THE ELEVATIONS IN ASCENDING ORDER

              NUM1=COUNT(SURF_CATCH.NE.0)
              DO 180 J1=0,NUM1-1
              DO 190 I1=1,NUM1-J1-1
              IF ((SURF_CATCH(I1).GT.SURF_CATCH(I1+1)).AND.
     &(SURF_CATCH(I1+1).GT.0)) THEN
              TEMP_SURF=SURF_CATCH(I1)
              SURF_CATCH(I1)=SURF_CATCH(I1+1)
              SURF_CATCH(I1+1)=TEMP_SURF
              TEMP_XF=XF(I1)
              XF(I1)=XF(I1+1)
              XF(I1+1)=TEMP_XF
              TEMP_YF=YF(I1)
              YF(I1)=YF(I1+1)
              YF(I1+1)=TEMP_YF
              END IF
190           CONTINUE
180           CONTINUE

              OUT_I=XF(1) ! COLUMN NO. OF OUTLET CELL
              OUT_J=YF(1) ! ROW NO. OF OUTLET CELL

              ! CHECK IF THE OUTLET ITSELF IS A SINK CELL. IN THAT CASE
              ! A NEW OUTLET CELL HAS TO BE FOUND OUT

              IF ((OUT_I.GE.2).AND.(OUT_J.GE.2).AND.(OUT_I.LE.COLS-1)
     &.AND.(OUT_J.LE.ROWS-1)) THEN
              CALL NEW_OUTLET1(XF,YF,OUT_I,OUT_J,DEM,CATCH_FLAG,ROWS,
     &COLS,SX)
              END IF
      END IF

      IF (SUM(CATCH_FLAG).EQ.1) THEN
              INDI=MAXLOC(CATCH_FLAG,MASK=CATCH_FLAG.GT.0)
              MM=INDI(1)
              NN=INDI(2)
              II=(/MM-1,MM-1,MM-1,MM,MM,MM,MM+1,MM+1,MM+1/)
              JJ=(/NN-1,NN,NN+1,NN-1,NN,NN+1,NN-1,NN,NN+1/)

              DO 200 N=1,9
              VALS(N)=DEM(II(N),JJ(N))
              III(N)=N
200           CONTINUE

              DO 210 J1=0,9-1
              DO 220 I1=1,9-J1-1
              IF ((VALS(I1).GT.VALS(I1+1)).AND.(VALS(I1+1).GT.0)) THEN
                      TEMP_SURF=VALS(I1)
                      VALS(I1)=VALS(I1+1)
                      VALS(I1+1)=TEMP_SURF
                      TEMP_II=III(I1)
                      III(I1)=III(I1+1)
                      III(I1+1)=TEMP_II
              END IF
220           CONTINUE
210           CONTINUE
              OUT_I=II(III(2))
              OUT_J=JJ(III(2))
      END IF

      RETURN

      END SUBROUTINE LAKE_CATCHMENT1
