! *****************************************************************************
MODULE ELMFIRE_IGNITION
! *****************************************************************************

USE ELMFIRE_VARS
USE ELMFIRE_SUBS
USE MPI_F08
USE SORT

IMPLICIT NONE

REAL :: XLL, XSPAN, YLL, YSPAN, RCOUNT_SUM, RCOUNT_NOERC_SUM

CONTAINS

! *****************************************************************************
SUBROUTINE DETERMINE_NUM_CASES_TOTAL
! *****************************************************************************

INTEGER :: ICOL, IROW, IWX_BAND, I, I1, I2, FLOOR_NUM_ENSEMBLE_MEMBERS, IPYROME, N
INTEGER, PARAMETER :: NUM_CASES_TOTAL_MAX = 10000000
REAL :: X, Y, RCOUNT, RCOUNT_NOERC, RNUM_ENSEMBLE_MEMBERS, FRAC, R0

IF (.NOT. RANDOM_IGNITIONS) THEN
   IF (MODE .NE. 2) THEN
      IWX_BAND_STOP = IWX_BAND_START
      ALLOCATE(NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND_START:IWX_BAND_STOP))
      NUM_CASES_PER_STARTING_WX_BAND(:) = NUM_ENSEMBLE_MEMBERS
      NUM_CASES_TOTAL                   = NUM_ENSEMBLE_MEMBERS
      NUM_STARTING_WX_BANDS             = 1
   ENDIF
ELSE
   ALLOCATE(NUM_CASES_PER_STARTING_WX_BAND             (IWX_BAND_START:IWX_BAND_STOP))
   ALLOCATE(NUM_CASES_COMPLETE_PER_STARTING_WX_BAND    (IWX_BAND_START:IWX_BAND_STOP))
   ALLOCATE(HOURLY_OUTPUTS_FROM_STARTING_WX_BAND_DUMPED(IWX_BAND_START:IWX_BAND_STOP))

   NUM_CASES_PER_STARTING_WX_BAND(:)           = 0
   NUM_CASES_COMPLETE_PER_STARTING_WX_BAND(:)  = 0
   HOURLY_OUTPUTS_FROM_STARTING_WX_BAND_DUMPED = .FALSE.

   IF (USE_IGNITION_MASK) THEN
      IXL_EDGEBUFFER = INT(EDGEBUFFER / IGN_MASK%CELLSIZE) + 1
      IYL_EDGEBUFFER = INT(EDGEBUFFER / IGN_MASK%CELLSIZE) + 1
      IXH_EDGEBUFFER = IGN_MASK%NCOLS - INT(EDGEBUFFER / IGN_MASK%CELLSIZE)
      IYH_EDGEBUFFER = IGN_MASK%NROWS - INT(EDGEBUFFER / IGN_MASK%CELLSIZE)

      DO IROW = 1, IGN_MASK%NROWS
         IF (REAL(IROW                    ) * IGN_MASK%CELLSIZE .LT. EDGEBUFFER) IGN_MASK%R4(:,IROW,1) = ASP%NODATA_VALUE
         IF (REAL(IGN_MASK%NROWS+1 - IROW ) * IGN_MASK%CELLSIZE .LT. EDGEBUFFER) IGN_MASK%R4(:,IROW,1) = ASP%NODATA_VALUE
      ENDDO

      DO ICOL = 1, IGN_MASK%NCOLS
         IF (REAL(ICOL                    ) * IGN_MASK%CELLSIZE .LT. EDGEBUFFER) IGN_MASK%R4(ICOL,:,1) = ASP%NODATA_VALUE
         IF (REAL(IGN_MASK%NCOLS+1 - ICOL ) * IGN_MASK%CELLSIZE .LT. EDGEBUFFER) IGN_MASK%R4(ICOL,:,1) = ASP%NODATA_VALUE
      ENDDO

      XSPAN = REAL(IGN_MASK%NCOLS) * IGN_MASK%CELLSIZE - 2.0 * EDGEBUFFER
      YSPAN = REAL(IGN_MASK%NROWS) * IGN_MASK%CELLSIZE - 2.0 * EDGEBUFFER
      XLL = IGN_MASK%XLLCORNER + EDGEBUFFER
      YLL = IGN_MASK%YLLCORNER + EDGEBUFFER

! Count up number of burnable pixels with nonzero ignition mask
      N=0
      DO IROW = IYL_EDGEBUFFER, IYH_EDGEBUFFER
      DO ICOL = IXL_EDGEBUFFER, IXH_EDGEBUFFER
         IF (IGN_MASK%R4(ICOL,IROW,1) .LT. IGN_MASK_CRIT ) CYCLE
         IF (ISNONBURNABLE(ICOL,IROW) .AND. (.NOT. ALLOW_NONBURNABLE_PIXEL_IGNITION)) CYCLE
         N = N + 1
      ENDDO
      ENDDO
      NUM_IGNITABLE_PIXELS = N

      ALLOCATE (N_ARR       (1:NUM_IGNITABLE_PIXELS))
      ALLOCATE (ICOL_ARR    (1:NUM_IGNITABLE_PIXELS))
      ALLOCATE (IROW_ARR    (1:NUM_IGNITABLE_PIXELS))
      ALLOCATE (IGN_MASK_ARR(1:NUM_IGNITABLE_PIXELS))
      ALLOCATE (PROB        (1:NUM_IGNITABLE_PIXELS+1))

      N=0
      DO IROW = IYL_EDGEBUFFER, IYH_EDGEBUFFER
      DO ICOL = IXL_EDGEBUFFER, IXH_EDGEBUFFER
         IF (IGN_MASK%R4(ICOL,IROW,1) .LT. IGN_MASK_CRIT) CYCLE
         IF (ISNONBURNABLE(ICOL,IROW) .AND. (.NOT. ALLOW_NONBURNABLE_PIXEL_IGNITION)) CYCLE
         N = N + 1
         N_ARR(N) = N
         ICOL_ARR(N) = ICOL
         IROW_ARR(N) = IROW
      ENDDO
      ENDDO

   ENDIF !USE_IGNITION_MASK

   ALLOCATE (IWX_BAND_START_TEMP (1:NUM_CASES_TOTAL_MAX))
   ALLOCATE (IWX_SERIAL_BAND_TEMP(1:NUM_CASES_TOTAL_MAX))

   NUM_STARTING_WX_BANDS = 0
   NUM_CASES_TOTAL       = 0

   IF (USE_ERC) THEN
      ALLOCATE(IX_IGNFAC(1:IGN_MASK%NCOLS))
      DO ICOL = 1, IGN_MASK%NCOLS
         X = X_FROM_ICOL (ICOL, IGN_MASK%XLLCORNER, IGN_MASK%CELLSIZE)
         IX_IGNFAC(ICOL) = MIN(MAX(ICOL_FROM_X (X, IGNFAC%XLLCORNER, IGNFAC%CELLSIZE),1),IGNFAC%NCOLS)
      ENDDO

      ALLOCATE(IY_IGNFAC(1:IGN_MASK%NROWS))
      DO IROW = 1, IGN_MASK%NROWS
         Y = Y_FROM_IROW (IROW, IGN_MASK%YLLCORNER, IGN_MASK%CELLSIZE)
         IY_IGNFAC(IROW) = MIN(MAX(IROW_FROM_Y (Y, IGNFAC%YLLCORNER, IGNFAC%CELLSIZE),1),IGNFAC%NROWS)
      ENDDO
   ENDIF

   RCOUNT_SUM = 0.
   DO IWX_BAND = IWX_BAND_START, IWX_BAND_STOP, IWX_BAND_SKIP

      NUM_STARTING_WX_BANDS = NUM_STARTING_WX_BANDS + 1

      SELECT CASE (RANDOM_IGNITIONS_TYPE)

         CASE(1)
            RCOUNT = REAL(NUM_IGNITABLE_PIXELS)

         CASE(2)

            RCOUNT = 0.
            IF (USE_ERC) THEN

               IF (IWX_BAND .EQ. IWX_BAND_START) THEN
                  RCOUNT_NOERC = 0.0
                  DO I = 1, NUM_IGNITABLE_PIXELS
                     IROW = IROW_ARR(I)
                     ICOL = ICOL_ARR(I)
                     IF (USE_PYROMES .AND. CALIBRATION_CONSTANTS_BY_PYROME) THEN
                        IPYROME = MIN(MAX(PYROMES%I2(ICOL,IROW,1),1),128)
                        RCOUNT_NOERC = RCOUNT_NOERC + IGNITION_MASK_SCALE_FACTOR * IGNITION_DENSITY_ADJ_PYROME(IPYROME) * IGN_MASK%R4(ICOL,IROW,1)
                     ELSE
                        RCOUNT_NOERC = RCOUNT_NOERC + IGNITION_MASK_SCALE_FACTOR * IGN_MASK%R4(ICOL,IROW,1)
                     ENDIF
                  ENDDO
                  RCOUNT_NOERC_SUM = RCOUNT_NOERC
               ELSE
                  RCOUNT_NOERC_SUM = RCOUNT_NOERC_SUM + RCOUNT_NOERC
               ENDIF

               DO I = 1, NUM_IGNITABLE_PIXELS
                  IROW = IROW_ARR(I)
                  ICOL = ICOL_ARR(I)
                  IF (USE_PYROMES .AND. CALIBRATION_CONSTANTS_BY_PYROME) THEN
                     IPYROME = MIN(MAX(PYROMES%I2(ICOL,IROW,1),1),128)
                     RCOUNT = RCOUNT + IGNITION_MASK_SCALE_FACTOR * IGNITION_DENSITY_ADJ_PYROME(IPYROME) * IGN_MASK%R4(ICOL,IROW,1) * IGNFAC%R4(IX_IGNFAC(ICOL),IY_IGNFAC(IROW),IWX_BAND)
                  ELSE
                     RCOUNT = RCOUNT + IGNITION_MASK_SCALE_FACTOR * IGN_MASK%R4(ICOL,IROW,1) * IGNFAC%R4(IX_IGNFAC(ICOL),IY_IGNFAC(IROW),IWX_BAND)
                  ENDIF
               ENDDO
               RCOUNT_SUM = RCOUNT_SUM + RCOUNT
            ELSE
               DO I = 1, NUM_IGNITABLE_PIXELS
                  IROW = IROW_ARR(I)
                  ICOL = ICOL_ARR(I)
                  IF (IGN_MASK%R4(ICOL,IROW,1) .GT. 0. ) THEN
                     IF (USE_PYROMES .AND. CALIBRATION_CONSTANTS_BY_PYROME) THEN
                        IPYROME = MIN(MAX(PYROMES%I2(ICOL,IROW,1),1),128)
                        RCOUNT = RCOUNT + IGNITION_MASK_SCALE_FACTOR * IGNITION_DENSITY_ADJ_PYROME(IPYROME) * IGN_MASK%R4(ICOL,IROW,1)
                     ELSE
                        RCOUNT = RCOUNT + IGNITION_MASK_SCALE_FACTOR * IGN_MASK%R4(ICOL,IROW,1)
                     ENDIF
                  ENDIF
               ENDDO
            ENDIF

        CASE DEFAULT
           WRITE(*,*) 'Error: Set RANDOM_IGNITIONS_TYPE to 1 or 2'
           STOP

      END SELECT

      IF (NUM_ENSEMBLE_MEMBERS0 .LT. 0) THEN
         RNUM_ENSEMBLE_MEMBERS = 0.01 * PERCENT_OF_PIXELS_TO_IGNITE * RCOUNT
         FLOOR_NUM_ENSEMBLE_MEMBERS = FLOOR(RNUM_ENSEMBLE_MEMBERS)
         FRAC = RNUM_ENSEMBLE_MEMBERS - REAL(FLOOR_NUM_ENSEMBLE_MEMBERS)
         CALL RANDOM_NUMBER(R0)
         IF (R0 .LE. FRAC) THEN
            NUM_ENSEMBLE_MEMBERS = FLOOR_NUM_ENSEMBLE_MEMBERS + 1
         ELSE
            NUM_ENSEMBLE_MEMBERS = FLOOR_NUM_ENSEMBLE_MEMBERS
         ENDIF
         IF (NUM_ENSEMBLE_MEMBERS .NE. NUM_ENSEMBLE_MEMBERS) NUM_ENSEMBLE_MEMBERS = 0
      ELSE
         IF (NUM_ENSEMBLE_MEMBERS .GT. NINT(RCOUNT) .AND. (.NOT. ALLOW_MULTIPLE_IGNITIONS_AT_A_PIXEL) ) THEN
            WRITE(*,100) 'Error:  NUM_ENSEMBLE_MEMBERS is greater than the total number of ignitable pixels'
            WRITE(*,100) 'Either reduce NUM_ENSEMBLE_MEMBERS, set ALLOW_MULTIPLE_IGNITIONS_AT_A_PIXEL = .TRUE.,'
            WRITE(*,100) 'or set NUM_ENSEMBLE_MEMBERS < 0 and specify PERCENT_OF_PIXELS_TO_IGNITE.'
            STOP
         ENDIF
      ENDIF

      IF (NUM_ENSEMBLE_MEMBERS .GT. 0 ) THEN
         NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND) = NUM_ENSEMBLE_MEMBERS
         I1 = NUM_CASES_TOTAL + 1
         I2 = NUM_CASES_TOTAL + NUM_ENSEMBLE_MEMBERS
         DO I = I1, I2
            IWX_BAND_START_TEMP(I) = IWX_BAND
            NUM_CASES_TOTAL = NUM_CASES_TOTAL + 1
            IWX_SERIAL_BAND_TEMP(I) = NUM_STARTING_WX_BANDS
         ENDDO
      ENDIF

   ENDDO ! IWX_BAND

!   IF (USE_ERC) DEALLOCATE(IX_IGNFAC, IY_IGNFAC)

ENDIF

IF (DUMP_CASES_TO_RUN_UP_FRONT) CALL WRITE_CASES_TO_RUN

100  FORMAT(A)

! *****************************************************************************
END SUBROUTINE DETERMINE_NUM_CASES_TOTAL
! *****************************************************************************

! *****************************************************************************
SUBROUTINE DETERMINE_IGNITION_LOCATIONS
! *****************************************************************************

INTEGER :: I, ICASE, ICOL, IROW, IWX_BAND, ICASE_FOR_WX_BAND
REAL :: R0, IGN_MASK_SUM

STATS_IWX_BAND_START(:)  = IWX_BAND_START_TEMP(1:NUM_CASES_TOTAL)
DEALLOCATE(IWX_BAND_START_TEMP)

STATS_IWX_SERIAL_BAND(:) = IWX_SERIAL_BAND_TEMP(1:NUM_CASES_TOTAL)
DEALLOCATE(IWX_SERIAL_BAND_TEMP)

ICASE = 0
IF (USE_ERC) THEN

   DO IWX_BAND = IWX_BAND_START, IWX_BAND_STOP, IWX_BAND_SKIP

      IF (NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND) .LT. 1) CYCLE

      IGN_MASK_SUM = 0.
      DO I = 1, NUM_IGNITABLE_PIXELS
         IROW = IROW_ARR(I)
         ICOL = ICOL_ARR(I)
         IGN_MASK_ARR(I) = IGN_MASK%R4(ICOL,IROW,1) * IGNFAC%R4(IX_IGNFAC(ICOL),IY_IGNFAC(IROW),IWX_BAND)
         IGN_MASK_SUM = IGN_MASK_SUM + IGN_MASK_ARR(I)
      ENDDO

      IGN_MASK_ARR(:) = IGN_MASK_ARR(:) / IGN_MASK_SUM

!      N_ARR_R = REAL(N_ARR(:))
!      CALL DSORT(IGN_MASK_ARR(:), N_ARR_R(:), NUM_IGNITABLE_PIXELS, 2)

      PROB(1) = 0.
      DO I = 2, NUM_IGNITABLE_PIXELS
         PROB(I) = PROB(I-1) + IGN_MASK_ARR(I-1)
      ENDDO
      PROB(NUM_IGNITABLE_PIXELS+1) = 1.

      DO ICASE_FOR_WX_BAND = 1, NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND)
         ICASE = ICASE + 1

         CALL RANDOM_NUMBER(R0)
         CALL LOCATE(PROB(:), NUM_IGNITABLE_PIXELS+1, R0, I)
         I = MIN(MAX(1,I),NUM_IGNITABLE_PIXELS)
         STATS_X(ICASE) = X_FROM_ICOL (ICOL_ARR(I), IGN_MASK%XLLCORNER, IGN_MASK%CELLSIZE)
         STATS_Y(ICASE) = Y_FROM_IROW (IROW_ARR(I), IGN_MASK%YLLCORNER, IGN_MASK%CELLSIZE)

         IF (RANDOM_IGNITIONS_TYPE .EQ. 1) THEN
            STATS_PROB(ICASE) = IGN_MASK%R4(ICOL_ARR(I),IROW_ARR(I),1)
         ELSE
            STATS_PROB(ICASE) = 1.
         ENDIF

      ENDDO
   ENDDO

ELSE

   IGN_MASK_SUM = 0.
   DO I = 1, NUM_IGNITABLE_PIXELS
      IROW = IROW_ARR(I)
      ICOL = ICOL_ARR(I)
      IGN_MASK_ARR(I) = IGN_MASK%R4(ICOL,IROW,1)
      IGN_MASK_SUM = IGN_MASK_SUM + IGN_MASK_ARR(I)
   ENDDO

   IGN_MASK_ARR(:) = IGN_MASK_ARR(:) / IGN_MASK_SUM

!   N_ARR_R = REAL(N_ARR(:))
!   CALL DSORT(IGN_MASK_ARR(:), N_ARR_R(:), N, 2)

   PROB(1) = 0.
   DO I = 2, NUM_IGNITABLE_PIXELS
      PROB(I) = PROB(I-1) + IGN_MASK_ARR(I-1)
   ENDDO
   PROB(NUM_IGNITABLE_PIXELS+1) = 1E0

   DO ICASE = 1, NUM_CASES_TOTAL

      CALL RANDOM_NUMBER(R0)
      CALL LOCATE(PROB(:), NUM_IGNITABLE_PIXELS+1, R0, I)
      I = MIN(MAX(1,I),NUM_IGNITABLE_PIXELS)
      STATS_X(ICASE) = X_FROM_ICOL (ICOL_ARR(I), IGN_MASK%XLLCORNER, IGN_MASK%CELLSIZE)
      STATS_Y(ICASE) = Y_FROM_IROW (IROW_ARR(I), IGN_MASK%YLLCORNER, IGN_MASK%CELLSIZE)

      IF (RANDOM_IGNITIONS_TYPE .EQ. 1) THEN
         STATS_PROB(ICASE) = IGN_MASK%R4(ICOL_ARR(I),IROW_ARR(I),1)
      ELSE
         STATS_PROB(ICASE) = 1.
      ENDIF

   ENDDO !ICASE = 1, NUM_CASES_TOTAL

ENDIF

DEALLOCATE(N_ARR, ICOL_ARR, IROW_ARR, IGN_MASK_ARR, PROB)
IF (USE_ERC) DEALLOCATE(IX_IGNFAC, IY_IGNFAC)

! *****************************************************************************
END SUBROUTINE DETERMINE_IGNITION_LOCATIONS
! *****************************************************************************

! *****************************************************************************
SUBROUTINE WRITE_CASES_TO_RUN
! *****************************************************************************

INTEGER :: IWX_BAND, IOS
CHARACTER(400) :: FN

FN = TRIM(OUTPUTS_DIRECTORY) // 'cases_to_run.csv'
OPEN(LUOUTPUT,FILE=TRIM(FN),FORM='FORMATTED',STATUS='REPLACE',IOSTAT=IOS)
WRITE(LUOUTPUT,9998) RCOUNT_SUM, RCOUNT_NOERC_SUM

WRITE(LUOUTPUT,'(A)') 'weather band,# cases'

DO IWX_BAND = IWX_BAND_START, IWX_BAND_STOP, IWX_BAND_SKIP
   WRITE(LUOUTPUT,9999) IWX_BAND, NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND)
ENDDO

CLOSE(LUOUTPUT)

9998 FORMAT(F16.9, ',', F16.9)
9999 FORMAT(I5,',',I4)

! *****************************************************************************
END SUBROUTINE WRITE_CASES_TO_RUN
! *****************************************************************************

! *****************************************************************************
SUBROUTINE DETERMINE_NUM_CASES_TOTAL_CSV
! *****************************************************************************

INTEGER :: I, IOS, N, IDUMMY, IWX_BAND
REAL :: RDUMMY
CHARACTER(400) :: FN

ALLOCATE(NUM_CASES_PER_STARTING_WX_BAND             (IWX_BAND_START:IWX_BAND_STOP))
ALLOCATE(NUM_CASES_COMPLETE_PER_STARTING_WX_BAND    (IWX_BAND_START:IWX_BAND_STOP))
ALLOCATE(HOURLY_OUTPUTS_FROM_STARTING_WX_BAND_DUMPED(IWX_BAND_START:IWX_BAND_STOP))

NUM_CASES_PER_STARTING_WX_BAND(:)           = 0
NUM_CASES_COMPLETE_PER_STARTING_WX_BAND(:)  = 0
HOURLY_OUTPUTS_FROM_STARTING_WX_BAND_DUMPED = .FALSE.

NUM_STARTING_WX_BANDS = 0
NUM_CASES_TOTAL       = 0

FN=TRIM(FUELS_AND_TOPOGRAPHY_DIRECTORY) // '/' // TRIM(IGNITIONS_CSV_FILENAME)
OPEN(LUINPUT,FILE=TRIM(FN),FORM='FORMATTED',STATUS='OLD',IOSTAT=IOS)
IF (IOS .NE. 0) THEN
   WRITE(*,*) 'Error:  ', TRIM(FN), 'not found'
   STOP
ENDIF

READ (LUINPUT,*,IOSTAT=IOS)
IF (IOS .NE. 0) THEN
   WRITE(*,*) 'Error:  bad header in', TRIM(FN)
   STOP
ENDIF

N = 0
DO WHILE (IOS .EQ. 0)
   READ(LUINPUT,*,IOSTAT=IOS) IDUMMY, IDUMMY, RDUMMY, RDUMMY
   IF (IOS .EQ. 0) N = N + 1
ENDDO
CLOSE(LUINPUT)

ALLOCATE (CSV_ICASEARR(1:N))
ALLOCATE (CSV_IBANDARR(1:N))
ALLOCATE (CSV_XARR(1:N))
ALLOCATE (CSV_YARR(1:N))

OPEN(LUINPUT,FILE=TRIM(FN),FORM='FORMATTED',STATUS='OLD',IOSTAT=IOS)
READ (LUINPUT,*,IOSTAT=IOS)
DO I = 1, N
   READ(LUINPUT,*,IOSTAT=IOS) CSV_ICASEARR(I), CSV_IBANDARR(I), CSV_XARR(I), CSV_YARR(I)
ENDDO
CLOSE(LUINPUT)
NUM_CASES_TOTAL=N

DO IWX_BAND = IWX_BAND_START, IWX_BAND_STOP, IWX_BAND_SKIP
   NUM_STARTING_WX_BANDS = NUM_STARTING_WX_BANDS + 1
   DO I = 1, NUM_CASES_TOTAL
      IF (CSV_IBANDARR(I) .EQ. IWX_BAND) NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND) = NUM_CASES_PER_STARTING_WX_BAND(IWX_BAND) + 1
   ENDDO
ENDDO

! *****************************************************************************
END SUBROUTINE DETERMINE_NUM_CASES_TOTAL_CSV
! *****************************************************************************

! *****************************************************************************
END MODULE ELMFIRE_IGNITION
! *****************************************************************************
