      SUBROUTINE CREV_LAKE1(C_MARK,DRAIN,MARK,ICE,
     &STRESS,PP,QQ,ROWS,COLS,WAT_DEP,SURF,DEM,RUNOFF,SUML,K1,K2,K3,K4,
     &CREV_DEP)

      ! THIS SUBROUTINE SIMULATES LAKE DRAINAGE VIA HYDROFRACTURE

      ! DESCRIPTION OF VARIABLES:

      ! 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

      ! DRAIN: SHOWS 1 FOR ALL THE LAKE CELLS THAT HAVE DRAINED AND 0
      ! OTHERWISE. GETS MODIFIED IN THIS SUBROUTINE

      ! MARK: USED TO DELINEATE A LAKE. SHOWS 1 FOR LAKE CELLS AND 0
      ! OTHERWISE. GETS MODIFIED IN THIS SUBROUTINE WHEN A LAKE DRAINS

      ! STRESS: CONTAINS STRESS (IN kPa) FOR EVERY GRID CELL. REMAINS
      ! UNMODIFIED IN THIS SUBROUTINE

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

      ! WAT_DEP: SHOWS DEPTH OF WATER (IN METERS) IN CREVASSED CELLS. FOR
      ! NON-CREVASSED CELLS, THE VALUE IS 0. GETS MODIFIED IN THIS
      ! SUBROUTINE

      ! SURF: CONTAINS SURFACE HEIGHT (IN METERS) OF EVERY GRID CELL.
      ! GETS MODIFIED IN THIS SUBROUTINE

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

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

      ! CREV_DEP: CONTAINS CREVASSE DEPTH FOR EVERY GRID CELL.
      ! GETS MODIFIED  IN THIS SUBROUTINE

      ! SUML: GIVES VOLUME OF WATER THAT DRAINS FROM A LAKE. GETS MODIFIED IN
      ! THIS SUBROUTINE

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

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

      ! K1,K2,K3,K4: GIVES THE EXTENT OF THE LAKE. UNMODIFIED IN THIS
      ! SUBROUTINE


      IMPLICIT NONE

      INTEGER :: II,JJ,ROWS,COLS,MARK(COLS,ROWS),COUNT_M,
     &PP,INDI(2),MM,NN,QQ,DRAIN(COLS,ROWS),K1,K2,K3,K4,
     &COUNT_D,D,C_MARK(COLS,ROWS),COUNT_C
      DOUBLE PRECISION ::  WAT_DEP(COLS,ROWS),LAKE_DEPTH(COLS,ROWS),AR,
     &VL,STRESS(COLS,ROWS),WAT,ICE(COLS,ROWS),V_OUT,SUML(COLS,ROWS),
     &SURF(COLS,ROWS),DEM(COLS,ROWS),RUNOFF(COLS,ROWS),
     &CREV_DEP(COLS,ROWS),CREV_LOC2(COLS,ROWS),SS,
     &SUM_RUN(COLS,ROWS),CREV_LOC(COLS,ROWS),WID,KI,KIC,B_WAT

      WID=0.6
      COUNT_C=0
      COUNT_D=0
      COUNT_M=0
      V_OUT=0
      KIC=150000
      LAKE_DEPTH=SURF-DEM

!     COLLECT ALL CREVASSES (IF ANY) THAT LIE UNDERNEATH THE LAKE

      DO 200 II=PP-K1,PP+K2
      DO 300 JJ=QQ-K3,QQ+K4
      IF (MARK(II,JJ).EQ.1) THEN ! IF LAKE PIXEL

!     CHECK IF THE LAKE IS DRAINING

              IF (DRAIN(II,JJ).EQ.1) THEN
                      COUNT_D=1 ! ACTIVATE THE DRAIN FLAG
              END IF
              IF (CREV_DEP(II,JJ).EQ.ICE(II,JJ)) THEN
                      CREV_LOC(II,JJ)=SURF(II,JJ)-DEM(II,JJ)
                      COUNT_M=1 ! ACTIVATE THE MOULIN FLAG
              END IF
              IF (C_MARK(II,JJ).EQ.1) THEN
                      CREV_LOC2(II,JJ)=SURF(II,JJ)-DEM(II,JJ)
                      COUNT_C=1 ! ACTIVATE ACTIVE CREVASSE FLAG
              END IF
      END IF
300   CONTINUE
200   CONTINUE

      ! IF A MOULIN EXISTS UNDERNEATH A LAKE

      IF (COUNT_M.EQ.1) THEN
              INDI=MAXLOC(CREV_LOC,MASK=CREV_LOC.GT.0)
              MM=INDI(1)
              NN=INDI(2)
              DO 400 II=PP-K1,PP+K2
              DO 401 JJ=QQ-K3,QQ+K4
              IF (MARK(II,JJ).EQ.1) THEN

                      ! THE LAKE DEPTHS THAT ARE LARGER THAN THE LAKE
                      ! DEPTH IN THE MOULIN WILL PARTIALLY LOSE THEIR
                      ! WATERS ELSE WILL COMPLETELY LOSE THEIR WATER

                      IF (LAKE_DEPTH(II,JJ).GT.LAKE_DEPTH(MM,NN)) THEN
                              SURF(II,JJ)=SURF(II,JJ)-LAKE_DEPTH(MM,NN)
                      ELSE
                              SURF(II,JJ)=DEM(II,JJ)
                              RUNOFF(II,JJ)=0
                      END IF
              END IF
401           CONTINUE
400           CONTINUE
      END IF

      ! IF LAKE HAS NOT DRAINED, CHECK FOR STRESS INTENSITY FACTOR AND
      ! DRAIN THE LAKE IF THE CRITICAL STRESS INTENSITY IS REACHED

      IF (COUNT_D.EQ.0) THEN
              WAT=(LAKE_DEPTH(PP,QQ)+RUNOFF(PP,QQ))*10000
!              WAT=(SUM(LAKE_DEPTH,MASK=MARK.EQ.1)+
!     &SUM(RUNOFF,MASK=MARK.EQ.1))*10000
              B_WAT=WAT/(WID*100)
              KI=1.12*STRESS(PP,QQ)*1000*SQRT(3.141*
     &ICE(PP,QQ))
     &-(0.683*900*9.8*(ICE(PP,QQ))**(1.5))+(0.683*1000*9.8*((B_WAT)
     &**1.5))
              IF (KI.GE.KIC) THEN
                      V_OUT=10000*
     &(SUM(RUNOFF,MASK=MARK.EQ.1))
     &+10000*(SUM(LAKE_DEPTH,MASK=MARK.EQ.1))+WID*100*
     &SUM(WAT_DEP,MASK=MARK.EQ.1)
                      DO 110 II=PP-K1,PP+K2
                      DO 120 JJ=QQ-K3,QQ+K4
                      IF (MARK(II,JJ).EQ.1) THEN
                              RUNOFF(II,JJ)=0 ! EMPTY RUNOFF
                              LAKE_DEPTH(II,JJ)=0 ! EMPTY LAKE
                              WAT_DEP(II,JJ)=0 ! EMPTY CREV.WATER
                              SURF(II,JJ)=DEM(II,JJ) ! SURFACE=DEM
                              DRAIN(II,JJ)=1 ! SET THE DRAIN FLAG
                              MARK(II,JJ)=0 ! UNSET THE LAKE FLAG
                      END IF
120                   CONTINUE
110                   CONTINUE
                      SUML(PP,QQ)=V_OUT
              ELSE
                      SUML(PP,QQ)=0
              END IF

      ELSE

              ! IF LAKE HAS ALREADY DRAIN THEN DRAIN THE ACCUMULATED
              ! WATER

              V_OUT=10000*(SUM(RUNOFF,MASK=MARK.EQ.1))+
     &10000*(SUM(LAKE_DEPTH,MASK=MARK.EQ.1))

              DO 150 II=PP-K1,PP+K2
              DO 160 JJ=QQ-K3,QQ+K4
              IF (MARK(II,JJ).EQ.1) THEN
                      RUNOFF(II,JJ)=0 ! EMPTY RUNOFF
                      LAKE_DEPTH(II,JJ)=0 ! EMPTY LAKE
                      SURF(II,JJ)=DEM(II,JJ) ! SURFACE=DEM
                      WAT_DEP(II,JJ)=0 ! EMPTY CREV.WATER
                      DRAIN(II,JJ)=1 ! SET THE DRAIN FLAG
                      MARK(II,JJ)=0 ! UNSET THE LAKE FLAG
              END IF
160           CONTINUE
150           CONTINUE
              SUML(PP,QQ)=V_OUT

      END IF

      RETURN

      END SUBROUTINE CREV_LAKE1
