diff --git a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
index fb2389640782d1defcd1f0507ead0652a36c9908..b6f9b7aff60ec73c5dfb6a7acaa320db8e91b369 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
@@ -1907,6 +1907,7 @@ INTEGER :: NB_REQ
!! ------
! N. Gicquel * CERFACS - CNRM *
! J. Escobar 18/08/2018 : Bug on MPI_RECV <-> uninitialized IMAXSIZESEND/IMAXSIZERECV variables
+! A. Costes 12/2021 : Adjust buffer size for Blaze
!
!-------------------------------------------------------------------------------
!
@@ -1926,6 +1927,8 @@ INTEGER :: NB_REQ
!JUANZ
USE MODD_CONFZ, ONLY : LMNH_MPI_BSEND
!JUANZ
+! Blaze
+USE MODD_FIRE, ONLY : LBLAZE,NREFINX,NREFINY
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -2009,7 +2012,12 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
IBUFFSIZE = IMAXSIZESEND
IF (IMAXSIZERECV > IBUFFSIZE) IBUFFSIZE = IMAXSIZERECV
!
- IBUFFSIZE = IBUFFSIZE * (NKMAX_TMP_ll + 2 * JPVEXT)
+ !Blaze
+ IF (LBLAZE) THEN
+ IBUFFSIZE = IBUFFSIZE * MAX(NKMAX_TMP_ll + 2 * JPVEXT,NREFINX*NREFINY)
+ ELSE
+ IBUFFSIZE = IBUFFSIZE * (NKMAX_TMP_ll + 2 * JPVEXT)
+ END IF
!
! JUAN
!if defined (MNH_MPI_ISEND)
@@ -2299,6 +2307,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
!! Author
!! ------
! N. Gicquel * CERFACS - CNRM *
+! A. Costes 12/2021: adjust buffer size for Blaze fire model
!
!-------------------------------------------------------------------------------
!
@@ -2314,6 +2323,8 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
!JUANZ
USE MODD_CONFZ, ONLY : LMNH_MPI_BSEND
!JUANZ
+!Blaze
+USE MODD_FIRE, ONLY : LBLAZE,NREFINX,NREFINY
!
!-------------------------------------------------------------------------------
!
@@ -2393,7 +2404,12 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
IBUFFSIZE = IMAXSIZESEND
IF (IMAXSIZERECV > IBUFFSIZE) IBUFFSIZE = IMAXSIZERECV
!
- IBUFFSIZE = IBUFFSIZE * (NKMAX_TMP_ll + 2 * JPVEXT)
+ !Blaze
+ IF (LBLAZE) THEN
+ IBUFFSIZE = IBUFFSIZE * MAX(NKMAX_TMP_ll + 2 * JPVEXT,NREFINX*NREFINY)
+ ELSE
+ IBUFFSIZE = IBUFFSIZE * (NKMAX_TMP_ll + 2 * JPVEXT)
+ END IF
! JUAN
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 27ab3f729991c45afae925bbc6824681d8d470ad..8d50c481531a7d306a0116b85af61257417d7079 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -15,6 +15,7 @@
! P. Wautelet 19/06/2019: add Fieldlist_nmodel_resize subroutine + provide KMODEL to INI_FIELD_LIST when known
! P. Wautelet 23/01/2020: split in modd_field.f90 and mode_field.f90
! JL Redelsperger 03/2021: add variables for Ocean LES and auto-coupled version
+! A. Costes 12/2021: add Blaze fire model variables
!-----------------------------------------------------------------
module mode_field
@@ -22,6 +23,7 @@ use modd_conf, only: cprogram
use modd_field
use modd_io, only: NVERB_DEBUG, NVERB_INFO, NVERB_WARNING, NVERB_ERROR, NVERB_FATAL
use modd_parameters, only: JPMODELMAX
+use modd_fire, only: NREFINX, NREFINY
use mode_msg
@@ -44,10 +46,11 @@ SUBROUTINE INI_FIELD_LIST(KMODEL)
!------------------------------------------------
USE MODD_CONF, ONLY: NMODEL
!
-INTEGER,INTENT(IN),OPTIONAL :: KMODEL
+INTEGER, INTENT(IN), OPTIONAL :: KMODEL
!
INTEGER :: IDX, IMODEL
CHARACTER(LEN=42) :: YMSG
+CHARACTER(LEN=3) :: YFIREDIMX, YFIREDIMY
!
!F90/95: TFIELDLIST(1) = TFIELDDATA('UT','x_wind','m s-1','XY','X_Y_Z_U component of wind',2)
!F2003:
@@ -59,6 +62,7 @@ IF (LFIELDLIST_ISINIT) THEN
CALL PRINT_MSG(NVERB_ERROR,'GEN','INI_FIELD_LIST','already called')
RETURN
END IF
+
LFIELDLIST_ISINIT = .TRUE.
!
IF (PRESENT(KMODEL)) THEN
@@ -2560,6 +2564,222 @@ TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
ALLOCATE(TFIELDLIST(IDX)%TFIELD_X2D(IMODEL))
IDX = IDX+1
!
+!
+! Blaze fire model fields
+!
+! get string of fire refinement ratio
+WRITE(YFIREDIMX, '(I3)') NREFINX
+WRITE(YFIREDIMY, '(I3)') NREFINY
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'LSPHI'
+TFIELDLIST(IDX)%CSTDNAME = 'level_set_function'
+TFIELDLIST(IDX)%CLONGNAME = 'LSPHI'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model level set function | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'BMAP'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_burning_map'
+TFIELDLIST(IDX)%CLONGNAME = 'BMAP'
+TFIELDLIST(IDX)%CUNITS = 's'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model burning map, i.e. arrival time matrix | &
+ fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMASE'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_model_available_sensible_energy'
+TFIELDLIST(IDX)%CLONGNAME = 'FMASE'
+TFIELDLIST(IDX)%CUNITS = 'kJ m-2'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model available sensible energy of vegetation | &
+ fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMAWC'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_model_available_water_content'
+TFIELDLIST(IDX)%CLONGNAME = 'FMAWC'
+TFIELDLIST(IDX)%CUNITS = 'kg m-2'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model available liquid water of vegetation | &
+ fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMWINDU'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_model_filtered_wind_u'
+TFIELDLIST(IDX)%CLONGNAME = 'FMWINDU'
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model EWAM filtered u wind | &
+ fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMWINDV'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_model_filtered_wind_v'
+TFIELDLIST(IDX)%CLONGNAME = 'FMWINDV'
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model EWAM filtered v wind &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMWINDW'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_model_filtered_wind_w'
+TFIELDLIST(IDX)%CLONGNAME = 'FMWINDW'
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model EWAM filtered w wind &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMHWS'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_model_filtered_horizontal_wind_speed'
+TFIELDLIST(IDX)%CLONGNAME = 'FMHWS'
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze filtered horizontal wind speed &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FIRERW'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_rate_of_spread'
+TFIELDLIST(IDX)%CLONGNAME = 'FIRERW'
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model rate of spread &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMR0'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_rate_of_spread_no_wind'
+TFIELDLIST(IDX)%CLONGNAME = 'FMR0'
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model rate of spread without wind and slope &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMFLUXHDH'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_sensible_heat_flux'
+TFIELDLIST(IDX)%CLONGNAME = 'FMFLUXHDH'
+TFIELDLIST(IDX)%CUNITS = 'W m-2'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model sensible heat flux &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMFLUXHDW'
+TFIELDLIST(IDX)%CSTDNAME = 'fire_latent_heat_flux'
+TFIELDLIST(IDX)%CLONGNAME = 'FMFLUXHDW'
+TFIELDLIST(IDX)%CUNITS = 'kg m-2 s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model latent heat flux &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMGRADOROX'
+TFIELDLIST(IDX)%CSTDNAME = 'orographic gradient on x direction on fire mesh'
+TFIELDLIST(IDX)%CLONGNAME = 'FMGRADOROX'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model orographic gradient on x direction on fire mesh &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'FMGRADOROY'
+TFIELDLIST(IDX)%CSTDNAME = 'orographic gradient on y direction on fire mesh'
+TFIELDLIST(IDX)%CLONGNAME = 'FMGRADOROY'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_F Blaze fire model orographic gradient on y direction on fire mesh &
+ | fire grid ('//YFIREDIMX//','//YFIREDIMY//')'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+! end of Blaze fields
+!
END IF !CPROGRAM=MESONH .OR. DIAG .OR. LFICDF .OR. SPAWN
!
!
@@ -3556,10 +3776,10 @@ TFIELDLIST(IDX)%CUNITS = ''
TFIELDLIST(IDX)%CDIR = ''
TFIELDLIST(IDX)%CLBTYPE = ''
TFIELDLIST(IDX)%CCOMMENT = ''
-TFIELDLIST(IDX)%NGRID =
-TFIELDLIST(IDX)%NTYPE =
-TFIELDLIST(IDX)%NDIMS =
-TFIELDLIST(IDX)%LTIMEDEP =
+TFIELDLIST(IDX)%NGRID =
+TFIELDLIST(IDX)%NTYPE =
+TFIELDLIST(IDX)%NDIMS =
+TFIELDLIST(IDX)%LTIMEDEP =
ALLOCATE(TFIELDLIST(IDX)%TFIELD_xxxD(IMODEL))
IDX = IDX+1
#endif
@@ -3576,7 +3796,7 @@ SUBROUTINE FIND_FIELD_ID_FROM_MNHNAME(HMNHNAME,KID,KRESP,ONOWARNING)
!
CHARACTER(LEN=*), INTENT(IN) :: HMNHNAME !Name of the field to find
INTEGER, INTENT(OUT):: KID !Index of the field
-INTEGER, INTENT(OUT):: KRESP !Return-code
+INTEGER, INTENT(OUT):: KRESP !Return-code
LOGICAL, OPTIONAL, INTENT(IN) :: ONOWARNING !If true, do not print warning
!
INTEGER :: IDX,JI
@@ -3611,7 +3831,7 @@ DO
ELSE IF (TRIM(TFIELDLIST(IDX)%CMNHNAME)==TRIM(HMNHNAME)) THEN
KID = IDX
EXIT
- ELSE
+ ELSE
IDX = IDX + 1
IF (IDX>MAXFIELDS) IDX = 1
END IF
@@ -4191,6 +4411,55 @@ IF (CPROGRAM=='REAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('VTDIS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XVTDIS
END IF
!
+! MODD_FIRE variables
+!
+CALL FIND_FIELD_ID_FROM_MNHNAME('LSPHI', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSPHI
+CALL FIND_FIELD_ID_FROM_MNHNAME('BMAP', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XBMAP
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMRFA', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMRFA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWF0', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMWF0
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMR0', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMR0
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMR00', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMR00
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMIGNITION', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMIGNITION
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMFUELTYPE', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMFUELTYPE
+CALL FIND_FIELD_ID_FROM_MNHNAME('FIRETAU', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFIRETAU
+CALL FIND_FIELD_ID_FROM_MNHNAME('FLUXPARAMH', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X4D(KFROM)%DATA => XFLUXPARAMH
+CALL FIND_FIELD_ID_FROM_MNHNAME('FLUXPARAMW', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X4D(KFROM)%DATA => XFLUXPARAMW
+CALL FIND_FIELD_ID_FROM_MNHNAME('FIRERW', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFIRERW
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMASE', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMASE
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMAWC', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMAWC
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWALKIG', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMWALKIG
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMFLUXHDH', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMFLUXHDH
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMFLUXHDW', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMFLUXHDW
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMHWS', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMHWS
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWINDU', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMWINDU
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWINDV', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMWINDV
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWINDW', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMWINDW
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMGRADOROX', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMGRADOROX
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMGRADOROY', IID,IRESP);
+IF (IRESP == 0) TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XFMGRADOROY
+!
!
!
!
@@ -4646,6 +4915,35 @@ IF (CPROGRAM=='REAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('VTDIS', IID,IRESP); XVTDIS => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
END IF
!
+!
+! MODD_FIRE variables
+!
+CALL FIND_FIELD_ID_FROM_MNHNAME('LSPHI', IID,IRESP); XLSPHI => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('BMAP', IID,IRESP); XBMAP => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMRFA', IID,IRESP); XFMRFA => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWF0', IID,IRESP); XFMWF0 => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMR0', IID,IRESP); XFMR0 => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMR00', IID,IRESP); XFMR00 => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMIGNITION', IID,IRESP); XFMIGNITION => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMFUELTYPE', IID,IRESP); XFMFUELTYPE => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FIRETAU', IID,IRESP); XFIRETAU => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FLUXPARAMH', IID,IRESP); XFLUXPARAMH => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FLUXPARAMW', IID,IRESP); XFLUXPARAMW => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FIRERW', IID,IRESP); XFIRERW => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMASE', IID,IRESP); XFMASE => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMAWC', IID,IRESP); XFMAWC => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWALKIG', IID,IRESP); XFMWALKIG => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMFLUXHDH', IID,IRESP); XFMFLUXHDH => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMFLUXHDW', IID,IRESP); XFMFLUXHDW => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMHWS', IID,IRESP); XFMHWS => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWINDU', IID,IRESP); XFMWINDU => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWINDV', IID,IRESP); XFMWINDV => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMWINDW', IID,IRESP); XFMWINDW => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMGRADOROX', IID,IRESP); XFMGRADOROX => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('FMGRADOROY', IID,IRESP); XFMGRADOROY => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+
+!
+!
END IF !KFROM/=KTO
!
END SUBROUTINE FIELDLIST_GOTO_MODEL
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index f73c628c8730c1f457010036351ef1b7263477b3..9b3c35bfbc57576c7fa9a7618e4c6a8a9c29cda2 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -69,6 +69,7 @@ END MODULE MODI_DEALLOCATE_MODEL1
! C. Lac 02/2019: add rain fraction as an output field
! P. Wautelet 07/06/2019: bugfix: deallocate XLSRVM only if allocated
! S. Riette 04/2020: XHL* fields
+! A. Costes 12:2021: Blaze Fire model variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -224,6 +225,146 @@ END IF
IF (ASSOCIATED(XDUMMY_GR_FIELDS) .AND. KCALL==3 ) THEN
DEALLOCATE(XDUMMY_GR_FIELDS)
END IF
+
+IF (ASSOCIATED(XLSPHI)) THEN
+ DEALLOCATE(XLSPHI)
+END IF
+
+IF (ASSOCIATED(XBMAP)) THEN
+ DEALLOCATE(XBMAP)
+END IF
+
+IF (ASSOCIATED(XFMRFA)) THEN
+ DEALLOCATE(XFMRFA)
+END IF
+
+IF (ASSOCIATED(XFMWF0)) THEN
+ DEALLOCATE(XFMWF0)
+END IF
+
+IF (ASSOCIATED(XFMR0)) THEN
+ DEALLOCATE(XFMR0)
+END IF
+
+IF (ASSOCIATED(XFMR00)) THEN
+ DEALLOCATE(XFMR00)
+END IF
+
+IF (ASSOCIATED(XFMIGNITION)) THEN
+ DEALLOCATE(XFMIGNITION)
+END IF
+
+IF (ASSOCIATED(XFMFUELTYPE)) THEN
+ DEALLOCATE(XFMFUELTYPE)
+END IF
+
+IF (ASSOCIATED(XFIRETAU)) THEN
+ DEALLOCATE(XFIRETAU)
+END IF
+
+IF (ASSOCIATED(XFLUXPARAMH)) THEN
+ DEALLOCATE(XFLUXPARAMH)
+END IF
+
+IF (ASSOCIATED(XFLUXPARAMW)) THEN
+ DEALLOCATE(XFLUXPARAMW)
+END IF
+
+IF (ASSOCIATED(XFIRERW)) THEN
+ DEALLOCATE(XFIRERW)
+END IF
+
+IF (ASSOCIATED(XFMASE)) THEN
+ DEALLOCATE(XFMASE)
+END IF
+
+IF (ASSOCIATED(XFMAWC)) THEN
+ DEALLOCATE(XFMAWC)
+END IF
+
+IF (ASSOCIATED(XFMWALKIG)) THEN
+ DEALLOCATE(XFMWALKIG)
+END IF
+
+IF (ASSOCIATED(XFMFLUXHDH)) THEN
+ DEALLOCATE(XFMFLUXHDH)
+END IF
+
+IF (ASSOCIATED(XFMFLUXHDW)) THEN
+ DEALLOCATE(XFMFLUXHDW)
+END IF
+
+IF (ASSOCIATED(XFMHWS)) THEN
+ DEALLOCATE(XFMHWS)
+END IF
+
+IF (ASSOCIATED(XFMWINDU)) THEN
+ DEALLOCATE(XFMWINDU)
+END IF
+
+IF (ASSOCIATED(XFMWINDV)) THEN
+ DEALLOCATE(XFMWINDV)
+END IF
+
+IF (ASSOCIATED(XFMWINDW)) THEN
+ DEALLOCATE(XFMWINDW)
+END IF
+
+IF (ASSOCIATED(XFMGRADOROX)) THEN
+ DEALLOCATE(XFMGRADOROX)
+END IF
+
+IF (ASSOCIATED(XFMGRADOROY)) THEN
+ DEALLOCATE(XFMGRADOROY)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIX)) THEN
+ DEALLOCATE(XGRADLSPHIX)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIY)) THEN
+ DEALLOCATE(XGRADLSPHIY)
+END IF
+
+IF (ASSOCIATED(XFIREWIND)) THEN
+ DEALLOCATE(XFIREWIND)
+END IF
+
+IF (ASSOCIATED(XLSPHI2D)) THEN
+ DEALLOCATE(XLSPHI2D)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIX2D)) THEN
+ DEALLOCATE(XGRADLSPHIX2D)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIY2D)) THEN
+ DEALLOCATE(XGRADLSPHIY2D)
+END IF
+
+IF (ASSOCIATED(XGRADMASKX)) THEN
+ DEALLOCATE(XGRADMASKX)
+END IF
+
+IF (ASSOCIATED(XGRADMASKY)) THEN
+ DEALLOCATE(XGRADMASKY)
+END IF
+
+IF (ASSOCIATED(XSURFRATIO2D)) THEN
+ DEALLOCATE(XSURFRATIO2D)
+END IF
+
+IF (ASSOCIATED(XLSDIFFUX2D)) THEN
+ DEALLOCATE(XLSDIFFUX2D)
+END IF
+
+IF (ASSOCIATED(XLSDIFFUY2D)) THEN
+ DEALLOCATE(XLSDIFFUY2D)
+END IF
+
+IF (ASSOCIATED(XFIRERW2D)) THEN
+ DEALLOCATE(XFIRERW2D)
+END IF
!
!* 3. Module MODD_GRID$n
!
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 67dde775a22dabd33d165459ca78edcc7ce611ba..d8dc56c4a3a12cfd1d12951c6996139fe08e6554 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -219,6 +219,7 @@ END MODULE MODI_DEFAULT_DESFM_n
! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
! Q. Rodier 07/2021: modify XPOND=1
+! A. Costes 12/2021: Blaze fire model
! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
! Delbeke/Vie 03/2022 : KHKO option in LIMA
!-------------------------------------------------------------------------------
@@ -308,6 +309,7 @@ USE MODD_IBM_LSF
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
+USE MODD_FIRE
!
IMPLICIT NONE
!
@@ -448,6 +450,7 @@ LHORELAX_SVLIMA = .FALSE.
LHORELAX_SVFF = .FALSE.
#endif
LHORELAX_SVSNW = .FALSE.
+LHORELAX_SVFIRE = .FALSE.
!
!
!-------------------------------------------------------------------------------
@@ -1417,5 +1420,61 @@ ENDIF
XTBVTOP = 500.
XTBVBOT = 300.
!
+!-------------------------------------------------------------------------------
+!
+!* 33. SET DEFAULT VALUES FOR MODD_FIRE
+! --------------------------------
!
+! Blaze fire model namelist
+!
+IF (KMI == 1) THEN
+ LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
+ !
+ CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
+ !
+ CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
+ CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
+ XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
+ !
+ CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
+ CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
+ LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
+ LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
+ !
+ NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
+ NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
+ !
+ NREFINX = 1 ! Refinement ratio X
+ NREFINY = 1 ! Refinement ratio Y
+ !
+ XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
+ XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
+ XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
+ !
+ XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
+ XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
+ !
+ XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
+ !
+ LWINDFILTER = .FALSE. ! Fire wind filtering flag
+ CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
+ XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
+ XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
+ XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
+ !
+ NNBSMOKETRACER = 1 ! Nb of smoke tracers
+ !
+ NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
+ !
+ !
+ !
+ !! DO NOT CHANGE BELOW PARAMETERS
+ XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
+ LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
+ LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
+ LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
+ LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
+ENDIF
+
+!-------------------------------------------------------------------------------
END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/MNH/firemodel.f90 b/src/MNH/firemodel.f90
new file mode 100644
index 0000000000000000000000000000000000000000..129029352e84aa1be3ea0ed546d85d9cc4cb8387
--- /dev/null
+++ b/src/MNH/firemodel.f90
@@ -0,0 +1,4207 @@
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!###################
+MODULE MODI_FIRE_MODEL
+!###################
+
+INTERFACE
+
+
+SUBROUTINE FIRE_GRADPHI( PLSPHI, PGRADLSPHIX, PGRADLSPHIY )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PGRADLSPHIX ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PGRADLSPHIY ! Grad of Phi on y direction
+
+END SUBROUTINE FIRE_GRADPHI
+
+
+SUBROUTINE FIRE_PROPAGATE( PLSPHI, PBMAP, PFMIGNITION, PFMWALKIG, PGRADLSPHIX, PGRADLSPHIY, PATMDT, PFIRERW )
+
+ IMPLICIT NONE
+
+ !! Level Set related
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSPHI ! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PBMAP ! Burning map
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMIGNITION ! Ignition map
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMWALKIG ! Walking ignition map
+
+ !! Gradient of LS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad of Phi on y direction
+
+ !! Others
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIRERW ! Rate of spread with wind
+ REAL, INTENT(IN) :: PATMDT ! Atm time step
+
+END SUBROUTINE FIRE_PROPAGATE
+
+
+SUBROUTINE FIRE_NOWINDROS( PFIREFUELMAP, PFMR0, PFMRFA, PFMWF0, PFMR00, PFMFUELTYPE, &
+ PFIRETAU, PFLUXPARAMH, PFLUXPARAMW, PFMASE, PFMAWC )
+
+ IMPLICIT NONE
+
+ !! Fuel map
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PFIREFUELMAP ! Fuel map
+
+ !! Rate of spread and factors
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMR0 ! Rate of spread without wind (R0)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMRFA ! Radiant factor (A)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWF0 ! Vertical flame velocity (v0)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMR00 ! Flame thickness speed factor (r0)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMFUELTYPE ! Fuel type
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIRETAU ! Residence time
+ REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PFLUXPARAMH ! params sensible heat flux model
+ REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PFLUXPARAMW ! params latent heat flux model
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Available sensible energy (J/m2)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Available water content (kg/m2)
+
+END SUBROUTINE FIRE_NOWINDROS
+
+
+SUBROUTINE FIRE_GETWIND( PUT, PVT, PWT, PGRADLSPHIX, PGRADLSPHIY, PFIREWIND, KTCOUNT, PATMDT, PFMGRADOROX, PFMGRADOROY )
+
+ IMPLICIT NONE
+
+ !! Atm wind
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT ! U Wind on atm grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVT ! V Wind on atm grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! W Wind on atm grid
+ !! Grad of Phi
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad Phi on y direction
+ !! Wind on fire grid
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIREWIND ! Wind Value on fire grid in -grad Phi direction
+ !
+ INTEGER, INTENT(IN) :: KTCOUNT ! Iteration number
+ REAL , INTENT(IN) :: PATMDT ! Atmospheric Time step
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROX ! Orography gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROY ! Orography gradient on y direction (dz/dy) [m/m]
+
+END SUBROUTINE FIRE_GETWIND
+
+
+SUBROUTINE FIRE_RATEOFSPREAD( PFMFUELTYPE, PFMR0, PFMRFA, PFMWF0, PFMR00, PFIREWIND, &
+ PGRADLSPHIX, PGRADLSPHIY, PFMGRADOROX, PFMGRADOROY, PFIRERW )
+
+ IMPLICIT NONE
+
+ !! Wind on fire grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIREWIND ! Wind on fire grid on -grad(phi) direction
+
+ !! Rate of spread and factors
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMR0 ! Rate of spread without wind (R0)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMRFA ! Radiant factor (A)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMWF0 ! Vertical flame velocity (v0)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMR00 ! Flame thickness speed factor (r0)
+
+ !! Fuel type
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMFUELTYPE ! Fuel type
+
+ !! Slope related
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad Phi on y direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROX ! Orography gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROY ! Orography gradient on y direction (dz/dy) [m/m]
+
+ !! ROS
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIRERW ! Rate of spread with wind and slope (R)
+
+END SUBROUTINE FIRE_RATEOFSPREAD
+
+
+SUBROUTINE FIRE_HEATFLUXES( PLSPHI, PBMAP, PFIRETAU, PATMDT, PFLUXPARAMH, PFLUXPARAMW, PFMFLUXHDH, PFMFLUXHDW, PFMASE, PFMAWC )
+
+ IMPLICIT NONE
+
+ !! LS related
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBMAP ! Burning map
+
+ !! Heat Flux param
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFLUXPARAMH ! Sensible heat flux parameters
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFLUXPARAMW ! Latent heat flux parameters
+
+ !! Heat Flux out
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMFLUXHDH ! Surface sensible heat flux (W/m2), fire grid
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMFLUXHDW ! Surface water flux (kg/m2/s), fire grid
+
+ !! Available energy
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMASE ! Available sensible energy (J/m2)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMAWC ! Available water content (kg/m2)
+
+ !! others
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIRETAU ! Residence time and fluxes parameters map
+ REAL, INTENT(IN) :: PATMDT ! Atm time step
+
+END SUBROUTINE FIRE_HEATFLUXES
+
+
+SUBROUTINE FIRE_VERTICALFLUXDISTRIB( PFMFLUXHDH, PFMFLUXHDW, PRTHS, PRRS, PSFTS, PEXNREF, PRHODJ, PRT, PRHODREF )
+
+ IMPLICIT NONE
+
+ !! Heat Flux in
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMFLUXHDH ! Surface sensible heat flux (W/m2), fire grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMFLUXHDW ! Surface water flux (kg/m2/s), fire grid
+
+ !! Sources
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS ! Potential temperature increment (K kg/s)
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! Water content increment (kg/s)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSFTS ! smoke flux (kg/kg/m2)
+
+ !! Others
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density times atm cell volume rho*J
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Water content (kg/kg)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! reference profile of density
+
+END SUBROUTINE FIRE_VERTICALFLUXDISTRIB
+
+
+SUBROUTINE FIRE_READFUEL( TPFILE, PFIREFUELMAP, PFMIGNITION, PFMWALKIG )
+
+ USE MODD_IO, ONLY: TFILEDATA
+
+ IMPLICIT NONE
+
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+ REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PFIREFUELMAP ! Fuel map
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMIGNITION ! Ignition map
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWALKIG ! Walking Ignition map
+
+END SUBROUTINE FIRE_READFUEL
+
+
+SUBROUTINE FIRE_READBMAP( TPFILE, PBMAP )
+
+ USE MODD_IO, ONLY: TFILEDATA
+
+ IMPLICIT NONE
+
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Ignition map
+
+END SUBROUTINE FIRE_READBMAP
+
+
+SUBROUTINE FIRE_RK( PLSPHI, PLSPHI1, PGRADLSPHIX, PGRADLSPHIY, PFIRERW, PFIREDT )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function at time t
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI1 ! Level Set function at time t+dtfire
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad of Phi on y direction
+
+ !! others
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIRERW ! Rate of spread with wind
+ REAL, INTENT(IN) :: PFIREDT ! Fire time step dtfire
+
+END SUBROUTINE FIRE_RK
+
+
+SUBROUTINE FIRE_WENO_1( PLSPHI2D, PGRADLSPHIX2D, PGRADLSPHIY2D, PGRADMASKX, PGRADMASKY )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIX2D ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIY2D ! Grad of Phi on y direction
+
+ !! others
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKX ! mask value x
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKY ! mask value y
+
+END SUBROUTINE FIRE_WENO_1
+
+
+SUBROUTINE FIRE_GRADMASK( PLSPHI2D, PGRADMASKX, PGRADMASKY, KMASKORDER )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADMASKX ! mask value x
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADMASKY ! mask value y
+
+ !! others
+ INTEGER, INTENT(IN) :: KMASKORDER ! Difference order
+
+END SUBROUTINE FIRE_GRADMASK
+
+
+SUBROUTINE FIRE_WENO_3( PLSPHI2D, PGRADLSPHIX2D, PGRADLSPHIY2D, PGRADMASKX, PGRADMASKY )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIX2D ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIY2D ! Grad of Phi on y direction
+
+ !! others
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKX ! mask value x
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKY ! mask value y
+
+END SUBROUTINE FIRE_WENO_3
+
+
+SUBROUTINE FIRE_LSDIFFU( PLSPHI, PLSDIFFUX, PLSDIFFUY )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSDIFFUX ! Laplacian of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSDIFFUY ! Laplacian of Phi on y direction
+
+END SUBROUTINE FIRE_LSDIFFU
+
+
+SUBROUTINE FIRE_ROSDIFFU( PFIRERW )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIRERW ! ROS
+
+END SUBROUTINE FIRE_ROSDIFFU
+
+
+SUBROUTINE FIRE_SUBGRIDSURFACE( PLSPHI2D, PSURFRATIO2D )
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function in 2D array
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PSURFRATIO2D ! Surface ratio in 2D array
+
+END SUBROUTINE FIRE_SUBGRIDSURFACE
+
+
+SUBROUTINE FIRE_QUANDRANTSURFACE( PPHI1, PPHI2, PPHI3, PPHI4, PSURFRATIO2D )
+
+ IMPLICIT NONE
+
+ !! LS value
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI1 ! Phi at south west point
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI2 ! Phi at south east point
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI3 ! Phi at north east point
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI4 ! Phi at north west point
+
+ !! bruning area
+ REAL,DIMENSION(:,:), INTENT(INOUT) :: PSURFRATIO2D ! Subgrid burning surface for cell
+
+END SUBROUTINE FIRE_QUANDRANTSURFACE
+
+
+SUBROUTINE FIRE_LS_RECONSTRUCTION_FROM_BMAP( PLSPHI, PBMAP, PATMDT )
+
+ IMPLICIT NONE
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBMAP ! Burning map
+ REAL, INTENT(IN) :: PATMDT ! Atm time step
+
+END SUBROUTINE FIRE_LS_RECONSTRUCTION_FROM_BMAP
+
+
+SUBROUTINE FIRE_GRAD_OROGRAPHY( PZS, PFMGRADOROX, PFMGRADOROY )
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! MNH orography (atm resolution) [m]
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMGRADOROX ! Orography gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMGRADOROY ! Orography gradient on y direction (dz/dy) [m/m]
+
+END SUBROUTINE FIRE_GRAD_OROGRAPHY
+
+
+FUNCTION FIRE_SURF_68( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+
+ IMPLICIT NONE
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+
+END FUNCTION FIRE_SURF_68
+
+
+FUNCTION FIRE_SURF_70( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+
+ IMPLICIT NONE
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+END FUNCTION FIRE_SURF_70
+
+
+FUNCTION FIRE_SURF_22( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+
+ IMPLICIT NONE
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+END FUNCTION FIRE_SURF_22
+
+
+FUNCTION FIRE_SURF_28( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+
+ IMPLICIT NONE
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+END FUNCTION FIRE_SURF_28
+
+
+! ************************ deprecated ************************
+FUNCTION FGET_I( PLINDEX, PMINDEX ) RESULT( POUTINDEX )
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: PLINDEX ! l fire index
+ INTEGER, INTENT(IN) :: PMINDEX ! m fire index
+
+ INTEGER :: POUTINDEX ! i atm index
+
+END FUNCTION FGET_I
+
+
+FUNCTION FGET_J( PLINDEX, PMINDEX ) RESULT( POUTINDEX )
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: PLINDEX ! l fire index
+ INTEGER, INTENT(IN) :: PMINDEX ! m fire index
+
+ INTEGER :: POUTINDEX ! i atm index
+
+END FUNCTION FGET_J
+
+
+FUNCTION FGET_K( PLINDEX, PMINDEX ) RESULT( POUTINDEX )
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: PLINDEX ! l fire index
+ INTEGER, INTENT(IN) :: PMINDEX ! m fire index
+
+ INTEGER :: POUTINDEX ! i atm index
+
+END FUNCTION FGET_K
+! ************************************************************
+
+
+END INTERFACE
+END MODULE MODI_FIRE_MODEL
+
+SUBROUTINE FIRE_GRADPHI( PLSPHI, PGRADLSPHIX, PGRADLSPHIY )
+ !!**** *FIRE_GRADPHI* - Fire model computation of Level set function gradient
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute gradient on x and y direcctions for level set function
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! WENO1 or WENO3
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !! PhD
+ !! [a] A. Costes PhD [2021]
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France/Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+ !
+ USE MODD_FIRE
+ USE MODI_FIRE_MODEL, ONLY: FIRE_GRADMASK, FIRE_WENO_1, FIRE_WENO_3
+ USE MODD_FIELD_n, ONLY : XLSPHI2D, XGRADLSPHIX2D, XGRADLSPHIY2D, XGRADMASKX, XGRADMASKY
+ !
+ USE MODE_MPPDB
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PGRADLSPHIX ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PGRADLSPHIY ! Grad of Phi on y direction
+ !
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: IIU, IJU ! atm mesh bounds
+ INTEGER :: ILU, IMU ! fire mesh bounds
+ INTEGER :: IKU ! fire 3rd dimension bounds
+ INTEGER :: IA,IB,II,IJ,IK,IL,IM ! Index for conversions
+ ! loop
+ INTEGER :: JI,JJ,JK ! index for atm mesh loop i,j,k
+ INTEGER :: JL,JM ! index for fire mesh loop l,m
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Allocate 2D array with fire grid bounds
+
+ ! get atm mesh bounds
+ IIU = SIZE(PLSPHI,1)
+ IJU = SIZE(PLSPHI,2)
+ IKU = SIZE(PLSPHI,3) ! NREFINX * NREFINY
+
+ ! fire mesh bounds
+ ILU = IIU*NREFINX
+ IMU = IJU*NREFINY
+
+ ! Default values
+ PGRADLSPHIX(:,:,:) = 0.
+ PGRADLSPHIY(:,:,:) = 0.
+
+ !* 2. Convert LS function Phi from 3d to 2d format
+
+ ! get l and m to find PHI2D(l,m) = PHI3D(i,j,k)
+ DO JK = 1, IKU
+ ! b = (k-1) \ NREFINX + 1 where \ means euclidian division
+ ! as k,1 and NREFINX are integers, (k-1)/NREFINX is an integer division
+ IB = (JK - 1) / NREFINX + 1
+ ! a = k - (b-1)*NREFINX
+ IA = JK - (IB - 1) * NREFINX
+ !
+ DO JJ = 1, IJU
+ ! m = (j-1)*NREFINY + b
+ IM = (JJ - 1) * NREFINY + IB
+ !
+ DO JI = 1, IIU
+ ! l = (i-1)*NREFINX + a
+ IL = (JI - 1) * NREFINX + IA
+ ! PHI2D(l,m) = PHI3D(i,j,k)
+ XLSPHI2D(IL,IM) = PLSPHI(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+ !* 3. Compute gradients on 2D grid
+
+ SELECT CASE(NFIRE_WENO_ORDER)
+ CASE(1)
+ ! Compute mask with 2nd order difference
+ CALL FIRE_GRADMASK( XLSPHI2D, XGRADMASKX, XGRADMASKY, 2 )
+ CALL FIRE_WENO_1( XLSPHI2D, XGRADLSPHIX2D, XGRADLSPHIY2D, XGRADMASKX, XGRADMASKY )
+ !
+ CASE(3)
+ ! Compute mask with 2nd order difference
+ CALL FIRE_GRADMASK( XLSPHI2D, XGRADMASKX, XGRADMASKY, 2 )
+ CALL FIRE_WENO_3( XLSPHI2D, XGRADLSPHIX2D, XGRADLSPHIY2D, XGRADMASKX, XGRADMASKY )
+ !
+ !
+ CASE DEFAULT
+ CALL FIRE_GRADMASK( XLSPHI2D, XGRADMASKX, XGRADMASKY, 2 )
+ CALL FIRE_WENO_1( XLSPHI2D, XGRADLSPHIX2D, XGRADLSPHIY2D, XGRADMASKX, XGRADMASKY )
+ END SELECT
+
+ !* 4. Convert gradients from 2d to 3d format
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+ DO JM = 1, IMU
+ ! j = ceil(m/NREFINY)
+ IJ = CEILING(REAL(JM) / REAL(NREFINY))
+ ! b = m - (j-1) * NREFINY
+ IB = JM - (IJ - 1) * NREFINY
+ !
+ DO JL = 1, ILU
+ ! i = ceil(l/NREFINX)
+ II = CEILING(REAL(JL) / REAL(NREFINX))
+ ! a = l - (i-1) * NREFINX
+ IA = JL - (II - 1) * NREFINX
+ ! k = (b-1) * NREFINX + a
+ IK = (IB - 1) * NREFINX + IA
+ ! GRAD3D(i,j,k) = GRAD2D(l,m)
+ PGRADLSPHIX(II,IJ,IK) = XGRADLSPHIX2D(JL,JM)
+ PGRADLSPHIY(II,IJ,IK) = XGRADLSPHIY2D(JL,JM)
+ END DO
+ END DO
+
+END SUBROUTINE FIRE_GRADPHI
+
+
+SUBROUTINE FIRE_PROPAGATE( PLSPHI, PBMAP, PFMIGNITION, PFMWALKIG, PGRADLSPHIX, PGRADLSPHIY, PATMDT, PFIRERW)
+ !!**** *FIRE_PROPAGATE* - propagate fire in time
+ !!
+ !! PURPOSE
+ !! -------
+ !! Use RK scheme to propagate fire un time
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !! PhD
+ !! [a] A. Costes PhD [2021]
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ USE MODI_FIRE_MODEL, ONLY: FIRE_RK, FIRE_LS_RECONSTRUCTION_FROM_BMAP
+ USE MODD_LUNIT_n, ONLY: TLUOUT
+
+ USE MODE_MPPDB
+
+ IMPLICIT NONE
+
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSPHI ! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PBMAP ! Burning map
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMIGNITION ! Ignition map
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMWALKIG ! Walking ignition map
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad of Phi on y direction
+ !
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIRERW ! Rate of spread with wind
+ !
+ REAL, INTENT(IN) :: PATMDT ! Atm time step
+ !
+
+ !* 0.2 declarations of local variables
+
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZLSPHI1 ! Level Set function at n+1
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRKK1 ! Runge Kutta 4 increment k1
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRKK2 ! Runge Kutta 4 increment k2
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRKK3 ! Runge Kutta 4 increment k3
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRKK4 ! Runge Kutta 4 increment k4
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRK4TMPPHI ! Runge Kutta 4 tmp phi field
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRK4GRADX ! Runge Kutta 4 tmp grad phi x
+ REAL, DIMENSION(SIZE(PLSPHI,1), SIZE(PLSPHI,2), SIZE(PLSPHI,3)) :: ZRK4GRADY ! Runge Kutta 4 tmp grad phi y
+
+ INTEGER :: INBITEFIRE ! # iteration in the propagation loop (ie. splitted atm time step)
+ REAL :: ZDTFIRE ! Fire time step
+ INTEGER :: JI
+
+ !* 1. Update Ignition
+ !* 1.1 Ignition map
+
+ WHERE (PFMIGNITION <= TDTCUR%XTIME )
+ ! update level set function where ignition starts at
+ PLSPHI = 1.
+ ! update bmap arrival time with ignition times
+ PBMAP = PFMIGNITION
+ END WHERE
+
+ !* 1.2 Walking ignition map at time t
+
+ CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( PLSPHI, PFMWALKIG, 0.)
+
+ !* 2. Compute # iteration in fire loop
+
+ INBITEFIRE = INT(PATMDT * MAXVAL(PFIRERW) / (XCFLMAXFIRE * MAX(XFIREMESHSIZE(1), XFIREMESHSIZE(2)))) + 1
+ IF (INBITEFIRE .NE. 1) THEN
+ WRITE(UNIT=TLUOUT%NLU,FMT=*) 'INFO BLAZE : INBITEFIRE is not 1 but is ', INBITEFIRE
+ END IF
+ ! Compute fire time step
+ ZDTFIRE = PATMDT / REAL(INBITEFIRE)
+
+ !* 3. Compute time integration
+
+ DO JI=1,INBITEFIRE
+ ! Call Runge kutta time integration
+ CALL FIRE_RK( PLSPHI, ZLSPHI1, PGRADLSPHIX, PGRADLSPHIY, PFIRERW, ZDTFIRE )
+ ! get overshoots
+ WHERE (ZLSPHI1 > 1.) ZLSPHI1 = 1.
+ WHERE (ZLSPHI1 < 0.) ZLSPHI1 = 0.
+ ! Update walking igniton at t+dt
+ CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( PLSPHI, PFMWALKIG, ZDTFIRE )
+ ! Update BMAP
+ WHERE (ZLSPHI1 >= .5 .AND. PBMAP < 0.)
+ ! where fire is passed, ie phi >= 0.5
+ ! but where the bmap is not already defined, ie BMap < 0 as default value is -1
+ ! Time increment of Bmap is computed by linear interpolation of Phi function crossing 0.5 value.
+ PBMAP = TDTCUR%XTIME + ZDTFIRE * ( 0.5 - PLSPHI ) / ( ZLSPHI1 - PLSPHI )
+ END WHERE
+ ! update phi value
+ PLSPHI = ZLSPHI1
+ END DO
+
+END SUBROUTINE FIRE_PROPAGATE
+
+
+SUBROUTINE FIRE_NOWINDROS( PFIREFUELMAP, PFMR0, PFMRFA, PFMWF0, PFMR00, PFMFUELTYPE, PFIRETAU, &
+ PFLUXPARAMH, PFLUXPARAMW, PFMASE, PFMAWC )
+ !!**** *FIRE_NOWINDROS* - Fire model computation of rate of spread without wind
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute of rate of spread without wind
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! Balbi model with Balbi fuel with 22 properties :
+ !! 1. Fuel type (<0 : Walking ignition, 0 : Unburnable, >0 : burnable)
+ !! 2. Rhod
+ !! 3. Rhol
+ !! 4. Md
+ !! 5. Ml
+ !! 6. sd
+ !! 7. sl
+ !! 8. Sigmad
+ !! 9. Sigmal
+ !! 10. e
+ !! 11. Ti
+ !! 12. Ta
+ !! 13. DeltaH
+ !! 14. Deltah
+ !! 15. Tau0
+ !! 16. stoch
+ !! 17. Rhoa
+ !! 18. cp
+ !! 19. cpa
+ !! 20. X0
+ !! 21. LAI
+ !! 22. r00
+ !! Fuel is set by python script into netcdf file in this order.
+ !! See pyrolib package on PyPi to create your script.
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Santoni et al. 2011
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST, ONLY : XSTEFAN
+ USE MODD_CONF, ONLY: CCONF
+ USE MODE_MPPDB
+ USE MODD_FIRE
+
+ IMPLICIT NONE
+
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Fuel map
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PFIREFUELMAP ! Fuel map
+
+ !! Rate of spread and factors
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMR0 ! Rate of spread without wind (R0)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMRFA ! Radiant factor (A)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWF0 ! Vertical flame velocity (v0)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMR00 ! Flame thickness speed factor (r0)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMFUELTYPE ! Fuel type
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIRETAU ! Residence time
+ REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PFLUXPARAMH ! params sensible heat flux model
+ REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PFLUXPARAMW ! params latent heat flux model
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Available sensible energy (J/m2)
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Available water content (kg/m2)
+ !
+
+ !* 0.2 declarations of local variables
+
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZBETAD, ZBETAL ! betad, betal : Packing ratio dry, living fuel
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZSD, ZSL ! Sd, Sl
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZNU ! nu
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZA ! a
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZA0 ! A0
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZXSI ! Xi
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZTF ! Tn : nominal radiant temperature
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZV00 ! v00
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZR00 ! R00
+ ! get fuel in 3d array to allow mask use
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELRHOD ! Rhod
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELRHOL ! Rhol
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELMD ! Md
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELML ! Ml
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELSD ! sd
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELSL ! sl
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELSIGMAD ! Sigmad
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELSIGMAL ! Sigmal
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELE ! e
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELTI ! Ti
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELTA ! Ta
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELDELTAH ! DeltaH
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELDH ! Deltah
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELTAU0 ! Tau0
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELSTOCH ! stoch
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELRHOA ! Rhoa
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELCP ! cp
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELCPA ! cpa
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELX0 ! X0
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELLAI ! LAI
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZFUELR00 ! r00
+
+ ! Work array
+ REAL, DIMENSION(SIZE(PFMR0,1),SIZE(PFMR0,2),SIZE(PFMR0,3)) :: ZWORK, ZWORK2, ZWORK3 ! Tmp array
+
+ ! combustion efficiency parameters
+ REAL, PARAMETER :: ZEC = 0.5
+ REAL, PARAMETER :: ZES = 0.1
+
+ ! loop, tests
+ INTEGER :: JI, JJ
+
+ !* 1. Get fuel in 3D array
+
+ PFMFUELTYPE = PFIREFUELMAP(:,:,:,1) ! Fuel type
+ ZFUELRHOD = PFIREFUELMAP(:,:,:,2) ! Rhod
+ ZFUELRHOL = PFIREFUELMAP(:,:,:,3) ! Rhol
+ ZFUELMD = PFIREFUELMAP(:,:,:,4) ! Md
+ ZFUELML = PFIREFUELMAP(:,:,:,5) ! Ml
+ ZFUELSD = PFIREFUELMAP(:,:,:,6) ! sd
+ ZFUELSL = PFIREFUELMAP(:,:,:,7) ! sl
+ ZFUELSIGMAD = PFIREFUELMAP(:,:,:,8) ! Sigmad
+ ZFUELSIGMAL = PFIREFUELMAP(:,:,:,9) ! Sigmal
+ ZFUELE = PFIREFUELMAP(:,:,:,10) ! e
+ ZFUELTI = PFIREFUELMAP(:,:,:,11) ! Ti
+ ZFUELTA = PFIREFUELMAP(:,:,:,12) ! Ta
+ ZFUELDELTAH = PFIREFUELMAP(:,:,:,13) ! DeltaH
+ ZFUELDH = PFIREFUELMAP(:,:,:,14) ! Deltah
+ ZFUELTAU0 = PFIREFUELMAP(:,:,:,15) ! Tau0
+ ZFUELSTOCH = PFIREFUELMAP(:,:,:,16) ! stoch
+ ZFUELRHOA = PFIREFUELMAP(:,:,:,17) ! Rhoa
+ ZFUELCP = PFIREFUELMAP(:,:,:,18) ! cp
+ ZFUELCPA = PFIREFUELMAP(:,:,:,19) ! cpa
+ ZFUELX0 = PFIREFUELMAP(:,:,:,20) ! X0
+ ZFUELLAI = PFIREFUELMAP(:,:,:,21) ! LAI
+ ZFUELR00 = PFIREFUELMAP(:,:,:,22) ! r00
+
+ !* 1. Compute unburnable area
+
+ WHERE (PFMFUELTYPE == 0.)
+ PFMR0 = 0.
+ PFMR00 = 0.
+ PFMRFA = 0.
+ PFMWF0 = 0.
+ END WHERE
+
+ !* 2. Compute Walking ignition
+
+ !! *********** deprecated ***********
+ WHERE (PFMFUELTYPE < 0.)
+ PFMR0 = -1. * PFMFUELTYPE
+ PFMR00 = 0.
+ PFMRFA = 0.
+ PFMWF0 = 0.
+ END WHERE
+ !! **********************************
+
+ !* 3. Compute R0, A, Wf0, r00
+
+ WHERE (PFMFUELTYPE > 0.)
+ ! betad = Sigmad / (e * Rhod)
+ ZBETAD = ZFUELSIGMAD / (ZFUELE * ZFUELRHOD)
+ ! betal = Sigmal / (e * Rhol)
+ ZBETAL = ZFUELSIGMAL / (ZFUELE * ZFUELRHOL)
+ ! Sd = sd * e * betad
+ ZSD = ZFUELSD * ZFUELE * ZBETAD
+ ! Sl = sl * e * betal
+ ZSL = ZFUELSL * ZFUELE * ZBETAL
+ ! nu = min(Sd/LAI,1)
+ ZNU = MIN(ZSD/ZFUELLAI,1.)
+ ! a = Deltah / (cp * (Ti - Ta))
+ ZA = ZFUELDH / (ZFUELCP * (ZFUELTI - ZFUELTA))
+ ! r0 = sd / r00
+ PFMR00 = ZFUELSD * ZFUELR00
+ ! A0 = X0 * DeltaH / (4. * cp *(Ti - Ta))
+ ZA0 = ZFUELX0 * ZFUELDELTAH / (4. * ZFUELCP * (ZFUELTI - ZFUELTA))
+ ! xsi = (Ml - Md) * (Sl/Sd) * (Deltah/DeltaH)
+ ZXSI = (ZFUELML - ZFUELMD) * (ZSL * ZFUELDH) / (ZSD * ZFUELDELTAH)
+ ! A = nu * A0 * (1. - xsi) / (1. + a*Md)
+ PFMRFA = ZNU * ZA0 * (1. - ZXSI) / (1. + ZA * ZFUELMD)
+ ! Tn = Ta + (DeltaH * (1. - X0)*(1-xsi)/(cpa*(1 + stoch)))
+ ZTF = ZFUELTA + (ZFUELDELTAH * (1. - ZFUELX0) * (1. - ZXSI) / (ZFUELCPA * (1. + ZFUELSTOCH)))
+ ! R00 = B * T^4 / (cp * (Ti - Ta))
+ ZR00 = XSTEFAN * ZTF**4 / (ZFUELCP * (ZFUELTI - ZFUELTA))
+ ! V00 = 2 * LAI * (1. + stoch) * Tn * Rhod / (rhoa * Ta * Tau0)
+ ZV00 = 2. * ZFUELLAI * (1. + ZFUELSTOCH) * ZTF * ZFUELRHOD / (ZFUELRHOA * ZFUELTA * ZFUELTAU0)
+ ! v0 = nu * V00
+ PFMWF0 = ZNU * ZV00
+ ! R0 = e * R00 / (Sigmad * (1. + a*Md)) * (Sd/(Sd+Sl))^2
+ PFMR0 = ZFUELE * ZR00 / (ZFUELSIGMAD * (1. + ZA * ZFUELMD)) * (ZSD / (ZSD + ZSL))**2
+ END WHERE
+
+ !* 4. Compute Residence time
+
+ ! Compute residence time
+ ! Tau = Tau0 / sd
+ WHERE (ZFUELSD /= 0) PFIRETAU = ZFUELTAU0 / ZFUELSD
+
+ !* 5. Compute Sensible heat flux parameters maps if needed
+
+ ZWORK(:,:,:) = 0.
+ ZWORK2(:,:,:) = 0.
+ ZWORK3(:,:,:) = 0.
+
+ ! Compute Sensible heat flux model param map if needed
+ SELECT CASE (CHEAT_FLUX_MODEL)
+ CASE('CST')
+ ! Nominal injection value is needed
+ ! INBPARAMSENSIBLE = 1
+ ! phih = Ec * (1 - X0) * sigmad * DeltaH / (Tau * (1. + Md))
+ ! Ec is combustion efficiency and set to 0.5
+ WHERE (PFIRETAU > 0) ZWORK = XFLXCOEFTMP * ZEC * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (PFIRETAU * (1. + ZFUELMD))
+ PFLUXPARAMH(:,:,:,1) = ZWORK(:,:,:)
+ !
+ ! Available Sensible Energy
+ IF (.NOT. LRESTA_ASE) THEN
+ WHERE (PFIRETAU > 0) PFMASE = XFLXCOEFTMP * ZEC * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (1. + ZFUELMD)
+ END IF
+
+ CASE('EXP')
+ ! Exponential injection
+ ! Nominal injection value is needed
+ ! Characteristic time value is needed
+ ! INBPARAMSENSIBLE = 2
+ ! phie = Ec * (1 - X0) * sigmad * DeltaH / (Taue * (1. + Md))
+ ! taue = - tauf / ln(1 - FERR)
+ ! tauf = flamming residence time
+ ! FERR = Flamming Energy Release Ratio (namelist parameter), 0.5 <= FERR < 1
+ ! Ec is combustion efficiency and set to 0.5
+ WHERE (PFIRETAU > 0)
+ ! taue
+ ZWORK = - PFIRETAU / LOG(1. - XFERR)
+ ! phie
+ ZWORK2 = XFLXCOEFTMP * ZEC * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (ZWORK * (1. + ZFUELMD))
+ END WHERE
+ PFLUXPARAMH(:,:,:,1) = ZWORK2(:,:,:)
+ PFLUXPARAMH(:,:,:,2) = ZWORK(:,:,:)
+ !
+ ! Available Sensible Energy
+ IF (.NOT. LRESTA_ASE) THEN
+ WHERE (PFIRETAU > 0) PFMASE = XFLXCOEFTMP * ZEC * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (1. + ZFUELMD)
+ END IF
+
+ CASE('EXS')
+ ! Exponential + smoldering injection
+ ! Nominal injection value is needed
+ ! Characteristic time value is needed
+ ! Smoldering injection value si needed
+ ! INBPARAMSENSIBLE = 3
+ ! phie = Ec * (1 - X0) * sigmad * DeltaH / (Taue * (1. + Md))
+ ! taue = - tauf / ln(1 - FERR)
+ ! phis = 0.006 * phih where phih is the nominal flux of CST model
+ ! tauf = flamming residence time
+ ! FERR = Flamming Energy Release Ratio (namelist parameter), 0.5 <= FERR < 1
+ ! Ec is combustion efficiency and set to 0.5
+ ! Es is smoldering energy consumption set to 0.1
+ WHERE (PFIRETAU > 0)
+ ! taue
+ ZWORK = - PFIRETAU / LOG(1. - XFERR)
+ ! phie
+ ZWORK2 = XFLXCOEFTMP * ZEC * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (ZWORK * (1. + ZFUELMD))
+ ! phis
+ ZWORK3 = .006 * XFLXCOEFTMP * ZEC * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (PFIRETAU * (1. + ZFUELMD))
+ END WHERE
+ PFLUXPARAMH(:,:,:,1) = ZWORK2(:,:,:)
+ PFLUXPARAMH(:,:,:,2) = ZWORK(:,:,:)
+ PFLUXPARAMH(:,:,:,3) = ZWORK3(:,:,:)
+ !
+ ! Available Sensible Energy
+ IF (.NOT. LRESTA_ASE) THEN
+ WHERE (PFIRETAU > 0) PFMASE = XFLXCOEFTMP * (ZEC + ZES) * (1. - ZFUELX0) * ZFUELSIGMAD * ZFUELDELTAH / (1. + ZFUELMD)
+ END IF
+ END SELECT
+
+ !* 5. Compute Sensible heat flux parameters maps if needed
+
+ ZWORK(:,:,:) = 0.
+ ZWORK2(:,:,:) = 0.
+
+ ! Compute Latent heat flux model param map if needed
+ SELECT CASE (CLATENT_FLUX_MODEL)
+ CASE('CST')
+ ! Nominal injection value is needed
+ ! INBPARAMLATENT = 1
+ ! phiw = (sigmad * Md + sigmal * Ml) / Tau
+ WHERE (PFIRETAU > 0) ZWORK = (ZFUELSIGMAD * ZFUELMD + ZFUELSIGMAL * ZFUELML) / PFIRETAU
+ PFLUXPARAMW(:,:,:,1) = ZWORK(:,:,:)
+ !
+ ! Available water content
+ IF (.NOT. LRESTA_AWC) THEN
+ WHERE(PFIRETAU > 0) PFMAWC = ZFUELSIGMAD * ZFUELMD + ZFUELSIGMAL * ZFUELML
+ END IF
+
+ CASE('EXP')
+ ! Exponential injection
+ ! Nominal injection value is needed
+ ! Characteristic time value is needed
+ ! INBPARAMSENSIBLE = 2
+ ! phie = (sigmad * Md + sigmal * Ml) / Tau
+ ! taue = - tauf / ln(1 - FERR)
+ ! tauf = flamming residence time
+ ! FERR = Flamming Energy Release Ratio (namelist parameter), 0.5 <= FERR < 1
+ ! Ec is combustion efficiency and set to 0.5
+ WHERE (PFIRETAU > 0)
+ ! taue
+ ZWORK = - PFIRETAU / LOG(1. - XFERR)
+ ! phie
+ ZWORK2 = (ZFUELSIGMAD * ZFUELMD + ZFUELSIGMAL * ZFUELML) / ZWORK
+ END WHERE
+ PFLUXPARAMW(:,:,:,1) = ZWORK2(:,:,:)
+ PFLUXPARAMW(:,:,:,2) = ZWORK(:,:,:)
+ !
+ ! Available water content
+ IF (.NOT. LRESTA_AWC) THEN
+ WHERE(PFIRETAU > 0) PFMAWC = ZFUELSIGMAD * ZFUELMD + ZFUELSIGMAL * ZFUELML
+ END IF
+ END SELECT
+
+END SUBROUTINE FIRE_NOWINDROS
+
+
+SUBROUTINE FIRE_GETWIND( PUT, PVT, PWT, PGRADLSPHIX, PGRADLSPHIY, PFIREWIND, KTCOUNT, PATMDT, PFMGRADOROX, PFMGRADOROY )
+ !!**** *FIRE_GETWIND* - Compute horizontal wind on fire mesh
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute horizontal wind on fire mesh. Horizontal interpolation and temporal filtering
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! See A. Costes PhD [2021], Chapter 2, Section 3.1.a for interpolation
+ !! See A. Costes PhD [2021], Chapter 2, Section 3.1.b for temporal filtering (EWAM recommended as WLIM is deprecated)
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_GRID_n, ONLY : XXHAT,XYHAT
+ USE MODI_SHUMAN, ONLY : MXF, MYF
+ USE MODD_CONF , ONLY : CCONF
+ USE MODD_FIELD_n, ONLY : XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW
+ !
+ USE MODD_FIRE
+ !
+ USE MODE_MPPDB
+
+ ! tmp use
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+ !! Atm wind
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT ! U Wind on atm grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVT ! V Wind on atm grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! W Wind on atm grid
+
+ !! Grad of Phi
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad Phi on y direction
+
+ !! Wind on fire grid
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIREWIND ! Wind Value on fire grid in -grad Phi direction
+
+ !! others
+ INTEGER, INTENT(IN) :: KTCOUNT ! Iteration number
+ REAL , INTENT(IN) :: PATMDT ! Atmospheric Time step
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROX ! Orography gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROY ! Orography gradient on y direction (dz/dy) [m/m]
+
+ !* 0.2 declarations of local variables
+
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),2) :: ZUM ! U wind on mass grid for first 2 levels
+ REAL, DIMENSION(SIZE(PVT,1),SIZE(PVT,2),2) :: ZVM ! V wind on mass grid for first 2 levels
+
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZGRADNORM ! Norm of grad phi with slope
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZNX ! Unit normal vector n on x direction
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZNY ! Unit normal vector n on y direction
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZNZ ! Unit normal vector n on z direction
+
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZWINDTMPU ! Wind U on fire grid
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZWINDTMPV ! Wind V on fire grid
+ REAL, DIMENSION(SIZE(PFIREWIND,1),SIZE(PFIREWIND,2),SIZE(PFIREWIND,3)) :: ZWINDTMPW ! Wind W on fire grid
+
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: ZIU1,ZIU2,ZIU3,ZIU4 ! U on atm mesh corners
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: ZIV1,ZIV2,ZIV3,ZIV4 ! V on atm mesh corners
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: ZIW1,ZIW2,ZIW3,ZIW4 ! W on atm mesh corners
+
+ REAL :: ZALPHAEWAM ! EWAM alpha constant
+
+ INTEGER :: IKU, IIU, IJU
+ INTEGER :: IL, IM
+ ! loop, tests
+ INTEGER :: JI, JJ, JK
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute fire front normal vector
+
+ ZGRADNORM = SQRT(PGRADLSPHIX**2 + PGRADLSPHIY**2 + (PGRADLSPHIX * PFMGRADOROX + PGRADLSPHIY * PFMGRADOROY)**2)
+
+ ! Normalize wind projection vectors on -gradphi vector
+ WHERE (ZGRADNORM > 0.)
+ ZNX = -1. * PGRADLSPHIX / ZGRADNORM
+ ZNY = -1. * PGRADLSPHIY / ZGRADNORM
+ ZNZ = -1. * (PGRADLSPHIX * PFMGRADOROX + PGRADLSPHIY * PFMGRADOROY) / ZGRADNORM
+ ELSEWHERE
+ ZNX = 0.
+ ZNY = 0.
+ ZNZ = 0.
+ END WHERE
+
+ IF (LINTERPWIND) THEN
+ !* 1. Horizontal interpolation fo wind
+ !* 1.1 get wind on atm corners
+ ! get atm array size
+ IIU = SIZE(PUT,1)
+ IJU = SIZE(PUT,2)
+ IKU = SIZE(PFIREWIND,3)
+ ! Default value
+ ZIU1(:,:) = 0.
+ ZIU2(:,:) = 0.
+ ZIU3(:,:) = 0.
+ ZIU4(:,:) = 0.
+ ZIV1(:,:) = 0.
+ ZIV2(:,:) = 0.
+ ZIV3(:,:) = 0.
+ ZIV4(:,:) = 0.
+ ZIW1(:,:) = 0.
+ ZIW2(:,:) = 0.
+ ZIW3(:,:) = 0.
+ ZIW4(:,:) = 0.
+ ! interpol sw corner
+ ZIU1(2:IIU-1,2:IJU-1) = .5 * (PUT(2:IIU-1,1:IJU-2,2) + PUT(2:IIU-1,2:IJU-1,2))
+ ZIV1(2:IIU-1,2:IJU-1) = .5 * (PVT(1:IIU-2,2:IJU-1,2) + PVT(2:IIU-1,2:IJU-1,2))
+ ZIW1(2:IIU-1,2:IJU-1) = .125 * &
+ (PWT(1:IIU-2,1:IJU-2,2) + PWT(2:IIU-1,1:IJU-2,2) + PWT(2:IIU-1,2:IJU-1,2) + PWT(1:IIU-2,2:IJU-1,2) + &
+ PWT(1:IIU-2,1:IJU-2,3) + PWT(2:IIU-1,1:IJU-2,3) + PWT(2:IIU-1,2:IJU-1,3) + PWT(1:IIU-2,2:IJU-1,3))
+ ! interpol se corner
+ ZIU2(2:IIU-1,2:IJU-1) = .5 * (PUT(3:IIU ,1:IJU-2,2) + PUT(3:IIU ,2:IJU-1,2))
+ ZIV2(2:IIU-1,2:IJU-1) = .5 * (PVT(3:IIU ,2:IJU-1,2) + PVT(2:IIU-1,2:IJU-1,2))
+ ZIW2(2:IIU-1,2:IJU-1) = .125 * &
+ (PWT(2:IIU-1,1:IJU-2,2) + PWT(3:IIU ,1:IJU-2,2) + PWT(3:IIU ,2:IJU-1,2) + PWT(2:IIU-1,2:IJU-1,2) + &
+ PWT(2:IIU-1,1:IJU-2,3) + PWT(3:IIU ,1:IJU-2,3) + PWT(3:IIU ,2:IJU-1,3) + PWT(2:IIU-1,2:IJU-1,3))
+ ! interpol ne corner
+ ZIU3(2:IIU-1,2:IJU-1) = .5 * (PUT(3:IIU ,3:IJU ,2) + PUT(3:IIU ,2:IJU-1,2))
+ ZIV3(2:IIU-1,2:IJU-1) = .5 * (PVT(3:IIU ,3:IJU ,2) + PVT(2:IIU-1,3:IJU ,2))
+ ZIW3(2:IIU-1,2:IJU-1) = .125 * &
+ (PWT(2:IIU-1,2:IJU-1,2) + PWT(3:IIU ,2:IJU-1,2) + PWT(3:IIU ,3:IJU ,2) + PWT(2:IIU-1,3:IJU ,2) + &
+ PWT(2:IIU-1,2:IJU-1,3) + PWT(3:IIU ,2:IJU-1,3) + PWT(3:IIU ,3:IJU ,3) + PWT(2:IIU-1,3:IJU ,3))
+ ! interpol nw corner
+ ZIU4(2:IIU-1,2:IJU-1) = .5 * (PUT(2:IIU-1,3:IJU ,2) + PUT(2:IIU-1,2:IJU-1,2))
+ ZIV4(2:IIU-1,2:IJU-1) = .5 * (PVT(1:IIU-2,3:IJU ,2) + PVT(2:IIU-1,3:IJU ,2))
+ ZIW4(2:IIU-1,2:IJU-1) = .125 * &
+ (PWT(1:IIU-2,2:IJU-1,2) + PWT(2:IIU-1,2:IJU-1,2) + PWT(2:IIU-1,3:IJU ,2) + PWT(1:IIU-2,3:IJU ,2) + &
+ PWT(1:IIU-2,2:IJU-1,3) + PWT(2:IIU-1,2:IJU-1,3) + PWT(2:IIU-1,3:IJU ,3) + PWT(1:IIU-2,3:IJU ,3))
+
+ !* 1.2 Interpol on fire grid
+ DO JK = 1, IKU
+ ! compute index position of grid cell
+ IM = (JK - 1) / NREFINX + 1
+ IL = JK - (IM - 1) * NREFINX
+ ! Interpol
+ ZWINDTMPU(:,:,JK) = (IM * (IL * ZIU3 + (NREFINX + 1 - IL) * ZIU4) + &
+ (NREFINY + 1 - IM) * (IL * ZIU2 + (NREFINX + 1 - IL) * ZIU1)) / &
+ REAL((NREFINX + 1) * (NREFINY + 1))
+ ZWINDTMPV(:,:,JK) = (IM * (IL * ZIV3 + (NREFINX + 1 - IL) * ZIV4) + &
+ (NREFINY + 1 - IM) * (IL * ZIV2 + (NREFINX + 1 - IL) * ZIV1)) / &
+ REAL((NREFINX + 1) * (NREFINY + 1))
+ ZWINDTMPW(:,:,JK) = (IM * (IL * ZIW3 + (NREFINX + 1 - IL) * ZIW4) + &
+ (NREFINY + 1 - IM) * (IL * ZIW2 + (NREFINX + 1 - IL) * ZIW1)) / &
+ REAL((NREFINX + 1) * (NREFINY + 1))
+ END DO
+ !
+ ELSE
+ !* 2. No interpolation. Share wind for each fire cell
+ !* 2.1 Get wind on mass grid
+
+ ZUM = MXF(PUT(:,:,1:2))
+ ZVM = MYF(PVT(:,:,1:2))
+
+ !* 2.2 Get wind on fire grid
+
+ IKU = SIZE(PFIREWIND,3)
+
+ ! Share wind for each fire cell in atm cell
+ DO JK = 1, IKU
+ ZWINDTMPU(:,:,JK) = ZUM(:,:,1)
+ ZWINDTMPV(:,:,JK) = ZVM(:,:,1)
+ ZWINDTMPW(:,:,JK) = .5*(PWT(:,:,2)+PWT(:,:,3))
+ END DO
+ END IF
+
+ !* 4. Wind filtering
+
+ IF (LWINDFILTER) THEN
+ SELECT CASE(CWINDFILTER)
+ CASE('EWAM')
+ IF (KTCOUNT <= 1 .AND. .NOT. LRESTA_EWAM) THEN
+ ! set first value of u and v filtered wind field
+ ! u filetered = u from MNH
+ XFMWINDU = ZWINDTMPU
+ ! v filetered = v from MNH
+ XFMWINDV = ZWINDTMPV
+ ! w filetered = v from MNH
+ XFMWINDW = ZWINDTMPW
+ ELSE
+ ZALPHAEWAM = 2. / (1. + CEILING(XEWAMTAU/PATMDT))
+ ! filter u
+ XFMWINDU = XFMWINDU + ZALPHAEWAM*(ZWINDTMPU - XFMWINDU)
+ ! filter v
+ XFMWINDV = XFMWINDV + ZALPHAEWAM*(ZWINDTMPV - XFMWINDV)
+ ! filter w
+ XFMWINDW = XFMWINDW + ZALPHAEWAM*(ZWINDTMPW - XFMWINDW)
+ END IF
+
+ CASE('WLIM')
+ ! initialize HWS to MNH wind
+ IF (KTCOUNT <= 1 .AND. .NOT. LRESTA_WLIM) THEN
+ XFMHWS = ZWINDTMPU * ZNX + ZWINDTMPV * ZNY + ZWINDTMPW * ZNZ
+ END IF
+ END SELECT
+ ELSE
+
+ ! u filetered = u from MNH
+ XFMWINDU = ZWINDTMPU
+ ! v filetered = v from MNH
+ XFMWINDV = ZWINDTMPV
+ ! w filetered = w from MNH
+ XFMWINDW = ZWINDTMPW
+
+ END IF
+
+ ! Compute scalar product
+ PFIREWIND = XFMWINDU * ZNX + XFMWINDV * ZNY + XFMWINDW * ZNZ
+
+ IF (LWINDFILTER) THEN
+ SELECT CASE(CWINDFILTER)
+ CASE('EWAM')
+ ! HWS filetered from PFIREWIND
+ XFMHWS = PFIREWIND
+
+ CASE('WLIM')
+ ! filter HWS
+ WHERE(XFMHWS <= XWLIMUTH)
+ ! do not change HWS
+ XFMHWS = PFIREWIND
+ ELSEWHERE
+ XFMHWS = MIN(PFIREWIND,XFMHWS + .005*(XWLIMUTMAX - PFIREWIND))
+ END WHERE
+ END SELECT
+ ! update PFIREWIND with filtered value
+ PFIREWIND = XFMHWS
+ ELSE
+ ! HWS filetered from PFIREWIND
+ XFMHWS = PFIREWIND
+ END IF
+
+END SUBROUTINE FIRE_GETWIND
+
+
+SUBROUTINE FIRE_RATEOFSPREAD( PFMFUELTYPE, PFMR0, PFMRFA, PFMWF0, PFMR00, PFIREWIND, &
+ PGRADLSPHIX, PGRADLSPHIY, PFMGRADOROX, PFMGRADOROY, PFIRERW )
+ !!**** *FIRE_NOWINDROS* - Fire model computation of horizontal wind on fire mesh
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute horizontal wind on fire mesh
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! Use Balbi rate of spread parameterization to compute ROS with wind and slope.
+ !! Wind and slope contributions to ROS are optional and can be selected through NWINDSLOPECPLMODE parameter.
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! Santoni et al. 2011
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODI_FIRE_MODEL, ONLY: FIRE_ROSDIFFU
+ USE MODE_MPPDB
+ USE MODD_TIME_n, ONLY : TDTCUR
+
+ IMPLICIT NONE
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Wind on fire grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIREWIND ! Wind on fire grid on -grad phi direction
+
+ !! Rate of spread and factors
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMR0 ! Rate of spread without wind (R0)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMRFA ! Radiant factor (A)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMWF0 ! Vertical flame velocity (v0)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMR00 ! Flame thickness speed factor (r0)
+
+ !! Fuel type
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMFUELTYPE ! Fuel type
+
+ !! Slope related
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad Phi on y direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROX ! Orography gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMGRADOROY ! Orography gradient on y direction (dz/dy) [m/m]
+
+ !! other
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIRERW ! Rate of spread with wind (R)
+
+ !* 0.2 declarations of local variables
+
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZTANGAMMA ! tan of Flame tilt angle (tan(gamma))
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZGEOMFACTOR ! Geometric factor
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZRTEMP ! Work ROS
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZTANALPHA ! tan(alpha) : slope angle in spread direction
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZGRADNORM ! norm of tilde(n)
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZGRADDIRX ! tilde(n) on x direction
+ REAL, DIMENSION(SIZE(PFIRERW,1),SIZE(PFIRERW,2),SIZE(PFIRERW,3)) :: ZGRADDIRY ! tilde(n) on y direction
+
+ ! loop, tests
+ INTEGER :: JI, JJ
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute flame tilt angle alpha
+
+ ! Slope contributes to tilt angle
+ ! Compute normale in horizontal plane
+ ZGRADNORM = SQRT(PGRADLSPHIX**2 + PGRADLSPHIY**2)
+
+ ! Normalize slope projection vectors on -gradphi vector
+ WHERE (ZGRADNORM > 0.)
+ ZGRADDIRX = -1. * PGRADLSPHIX / ZGRADNORM
+ ZGRADDIRY = -1. * PGRADLSPHIY / ZGRADNORM
+ ELSEWHERE
+ ZGRADDIRX = 0.
+ ZGRADDIRY = 0.
+ END WHERE
+ ! tilde(n) dot h in the horizontal plane
+ ZTANALPHA = ZGRADDIRX * PFMGRADOROX + ZGRADDIRY * PFMGRADOROY
+
+ !* 2. Compute tan(gamma)
+
+ SELECT CASE(NWINDSLOPECPLMODE)
+ CASE(0)
+ ! Slope and wind do contribute to tilt angle
+ WHERE (PFMWF0 > 0)
+ ZTANGAMMA = ZTANALPHA + PFIREWIND/PFMWF0
+ ELSEWHERE
+ ZTANGAMMA = ZTANALPHA
+ END WHERE
+
+ CASE(1)
+ ! Slope does not contribute to tilt angle but wind does
+ WHERE (PFMWF0 > 0)
+ ZTANGAMMA = PFIREWIND/PFMWF0
+ ELSEWHERE
+ ZTANGAMMA = 0.
+ END WHERE
+
+ CASE(2)
+ ! Slope do contribute to tilt angle but not wind
+ ZTANGAMMA = ZTANALPHA
+ END SELECT
+
+ !* 3. Compute ROS
+
+ WHERE (ZTANGAMMA > 0)
+ ! geom factor = r0 * (1. + sin(gamma) - cos(gamma)) / cos(gamma)
+ ! strictly equivalent to r0 * (sqrt(1-tan(gamma)^2) + tan(gamma) - 1) which is much more computationaly efficient
+ ZGEOMFACTOR = PFMR00 * (SQRT(1. + ZTANGAMMA**2) + ZTANGAMMA - 1.)
+ ! Rt = R0 + A * geomfactor - r0 / cos(gamma)
+ ZRTEMP = PFMR0 + PFMRFA * ZGEOMFACTOR - PFMR00 * SQRT(1. + ZTANGAMMA**2)
+ ! Rw = 0.5 * (Rt + sqrt(Rt**2 + 4. * r0 * R0 / cos(gamma)))
+ PFIRERW = .5 * (ZRTEMP + SQRT(ZRTEMP**2 + 4. * PFMR00 * PFMR0 * SQRT(1. + ZTANGAMMA**2)))
+ ELSEWHERE
+ PFIRERW = PFMR0
+ END WHERE
+
+ SELECT CASE(NWINDSLOPECPLMODE)
+ CASE(0,2)
+ ! Slope projection
+ ! tilde(R) = R / sqrt(1+tan(alpha)^2)
+ PFIRERW = PFIRERW / SQRT(1. + ZTANALPHA**2)
+ END SELECT
+
+ ! ROS diffusion
+ CALL FIRE_ROSDIFFU( PFIRERW )
+
+ ! protection
+ WHERE(PFMR0 <= 0.) PFIRERW = 0.
+ SELECT CASE(NWINDSLOPECPLMODE)
+ CASE(0,2)
+ WHERE(PFIRERW < PFMR0 / SQRT(1. + ZTANALPHA**2)) PFIRERW = PFMR0 / SQRT(1. + ZTANALPHA**2)
+
+ CASE(1)
+ WHERE(PFIRERW < PFMR0) PFIRERW = PFMR0
+ END SELECT
+
+ ! Walking Ignition
+ WHERE(PFMFUELTYPE < 0) PFIRERW = -1. * PFMFUELTYPE
+
+END SUBROUTINE FIRE_RATEOFSPREAD
+
+
+SUBROUTINE FIRE_HEATFLUXES( PLSPHI, PBMAP, PFIRETAU, PATMDT, PFLUXPARAMH, PFLUXPARAMW, PFMFLUXHDH, PFMFLUXHDW, PFMASE, PFMAWC )
+ !!**** *FIRE_HEATFLUXES* - Fire model computation of heat fluxes
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute sensible and latent heat fluxes
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! See A. Costes PhD [2021], chapter 2 Section 3.3
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ USE MODI_FIRE_MODEL, ONLY: FIRE_SUBGRIDSURFACE
+ USE MODD_FIELD_n, ONLY : XLSPHI2D, XSURFRATIO2D
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBMAP ! Burning map
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIRETAU ! Residence time and fluxes parameters map
+ REAL, INTENT(IN) :: PATMDT ! Atm time step
+ ! Heat Flux param
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFLUXPARAMH ! Sensible heat flux parameters
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFLUXPARAMW ! Latent heat flux parameters
+ ! Heat Flux out
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMFLUXHDH ! Surface sensible heat flux (W/m2), fire grid
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMFLUXHDW ! Surface water flux (kg/m2/s), fire grid
+
+ ! Available energy
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMASE ! Available sensible energy (J/m2)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFMAWC ! Available water content (kg/m2)
+
+ !* 0.2 declarations of local variables
+ ! Heat Flux
+ REAL, DIMENSION(SIZE(PBMAP,1),SIZE(PBMAP,2),SIZE(PBMAP,3)) :: ZSURFRATIO ! Burning surface ratio 3D
+
+ REAL, DIMENSION(SIZE(PBMAP,1),SIZE(PBMAP,2),SIZE(PBMAP,3)) :: ZWORK,ZWORK2,ZWORK3 ! Work array
+
+ INTEGER :: INBPARAMSENSIBLE, INBPARAMLATENT
+ INTEGER :: IIU,IJU,IKU ! Atmospheric mesh used for fire mesh wind computation
+ REAL :: ZMAXARRIVALTIME ! t+dt/2 as time integration of LS function is already performed
+
+ REAL, PARAMETER :: ZMINENERGY = 1.0E-6
+
+ ! loop, tests
+ INTEGER :: JI, JJ, JK, JL, JM
+ INTEGER :: II, IJ, IK, IA, IB, IL, IM
+ !----------------------------------------------------------------------------------------------
+ !
+ !* 1. Get time and indexes
+
+ ZMAXARRIVALTIME = TDTCUR%XTIME + PATMDT
+
+ ! Get atm mesh concerned by routine
+ IIU = SIZE(PBMAP,1)
+ IJU = SIZE(PBMAP,2)
+ IKU = SIZE(PBMAP,3)
+
+ !* 2. get surface ratio for each fire cell
+
+ !* 2.1 LSPHI 3D -> 2D
+
+ ! get l and m to find PHI2D(l,m) = PHI3D(i,j,k)
+ DO JK = 1, IKU
+ ! b = (k-1) \ NREFINX + 1 where \ means euclidian division
+ ! as k,1 and NREFINX are integers, (k-1)/NREFINX is an integer division
+ IB = (JK - 1) / NREFINX + 1
+ ! a = k - (b-1)*NREFINX
+ IA = JK - (IB - 1) * NREFINX
+ !
+ DO JJ = 1, IJU
+ ! m = (j-1)*NREFINY + b
+ IM = (JJ - 1) * NREFINY + IB
+ !
+ DO JI = 1, IIU
+ ! l = (i-1)*NREFINX + a
+ IL = (JI - 1) * NREFINX + IA
+ ! PHI2D(l,m) = PHI3D(i,j,k)
+ XLSPHI2D(IL,IM) = PLSPHI(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+ !* 2.2 get surface ratio 2D
+
+ ! -----------------------------------------------------------------------------
+ ! OLD METHOD WITHOUT RECONSTRUCTION
+ ! -----------------------------------------------------------------------------
+ IF (LSGBAWEIGHT) THEN
+ !
+ DO JM = 2, IJU*NREFINY - 1
+ DO JL = 2, IIU*NREFINX - 1
+ XSURFRATIO2D(JL,JM) = 9. / 16. * XLSPHI2D(JL,JM) &
+ + 3. / 32. * (XLSPHI2D(JL-1,JM) + XLSPHI2D(JL,JM-1) + XLSPHI2D(JL+1,JM) + XLSPHI2D(JL,JM+1)) &
+ + 1. / 64. * (XLSPHI2D(JL-1,JM-1) + XLSPHI2D(JL+1,JM-1) + XLSPHI2D(JL+1,JM+1) + XLSPHI2D(JL-1,JM+1))
+ END DO
+ END DO
+ ! -----------------------------------------------------------------------------
+ ELSE
+
+ CALL FIRE_SUBGRIDSURFACE( XLSPHI2D, XSURFRATIO2D )
+
+ END IF
+
+ !* 2.3 convert surface ratio 2D to 3D
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+ DO JM = 1, IJU*NREFINY
+ ! j = ceil(m/NREFINY)
+ IJ = CEILING(REAL(JM) / REAL(NREFINY))
+ ! b = m - (j-1) * NREFINY
+ IB = JM - (IJ - 1) * NREFINY
+ !
+ DO JL = 1, IIU*NREFINX
+ ! i = ceil(l/NREFINX)
+ II = CEILING(REAL(JL) / REAL(NREFINX))
+ ! a = l - (i-1) * NREFINX
+ IA = JL - (II - 1) * NREFINX
+ ! k = (b-1) * NREFINX + a
+ IK = (IB - 1) * NREFINX + IA
+ ! GRAD3D(i,j,k) = GRAD2D(l,m)
+ ZSURFRATIO(II,IJ,IK) = XSURFRATIO2D(JL,JM)
+ END DO
+ END DO
+
+ !* 3. Sensible Heat flux
+
+ ! init fire resolution flux
+ PFMFLUXHDH(:,:,:) = 0.
+
+ !* 3.1 Injection value function of models
+
+ SELECT CASE (CHEAT_FLUX_MODEL)
+ CASE('CST')
+ ! Nominal value injection everywhere
+ ! Effective injection if energy is Available
+ PFMFLUXHDH(:,:,:) = ZSURFRATIO(:,:,:) * PFLUXPARAMH(:,:,:,1)
+
+ CASE('EXP')
+ ! NBPARAM
+ ! INBPARAMSENSIBLE = 2
+ ! get heat flux params
+ ! Phie
+ ZWORK(:,:,:) = PFLUXPARAMH(:,:,:,1)
+ ! Taue
+ ZWORK2(:,:,:) = PFLUXPARAMH(:,:,:,2)
+ !
+ WHERE( PBMAP >= 0 .AND. ZWORK2 > 0)
+ PFMFLUXHDH = ZSURFRATIO * ZWORK * EXP(-1. * (TDTCUR%XTIME - PBMAP) / ZWORK2)
+ ELSEWHERE
+ PFMFLUXHDH = ZSURFRATIO * ZWORK
+ END WHERE
+ ! Minimal flux injection 0.001*Phie
+ WHERE(PFMFLUXHDH < .01 * ZWORK) PFMFLUXHDH = ZSURFRATIO * .01 * ZWORK
+
+ CASE('EXS')
+ ! NBPARAM
+ ! INBPARAMSENSIBLE = 3
+ ! get heat flux params
+ ! Phie
+ ZWORK(:,:,:) = PFLUXPARAMH(:,:,:,1)
+ ! Taue
+ ZWORK2(:,:,:) = PFLUXPARAMH(:,:,:,2)
+ ! phis
+ ZWORK3(:,:,:) = PFLUXPARAMH(:,:,:,3)
+ !
+ WHERE( PBMAP >= 0 .AND. ZWORK2 > 0)
+ PFMFLUXHDH = ZSURFRATIO * (ZWORK * EXP(-1. * (TDTCUR%XTIME - PBMAP) / ZWORK2) + ZWORK3)
+ ELSEWHERE
+ PFMFLUXHDH = ZSURFRATIO * (ZWORK + ZWORK3)
+ END WHERE
+
+ END SELECT
+
+ !* 3.2 Injection limitation function of Available energy
+ ! Check if heat flux if below Available sensible energy
+ WHERE ( PFMASE < ZMINENERGY )
+ PFMFLUXHDH = 0.
+ END WHERE
+
+ !
+ WHERE ( PFMASE < PFMFLUXHDH * PATMDT)
+ PFMFLUXHDH = PFMASE / PATMDT
+ END WHERE
+
+ ! Remove injected energy from Available energy
+ PFMASE(:,:,:) = PFMASE(:,:,:) - PFMFLUXHDH(:,:,:) * PATMDT
+
+ !* 4. Latente Heat flux
+
+ ! init fire resolution flux
+ PFMFLUXHDW(:,:,:) = 0.
+
+ !* 4.1 CST model
+
+ SELECT CASE (CLATENT_FLUX_MODEL)
+ CASE('CST')
+ ! Nominal value injection everywhere
+ ! Effective injection if energy is Available
+ PFMFLUXHDW(:,:,:) = ZSURFRATIO(:,:,:) * PFLUXPARAMW(:,:,:,1)
+
+ CASE('EXP')
+ ! NBPARAM
+ ! INBPARAMLATENT = 2
+ ! get latent flux params
+ ! Phie
+ ZWORK(:,:,:) = PFLUXPARAMW(:,:,:,1)
+ ! Taue
+ ZWORK2(:,:,:) = PFLUXPARAMW(:,:,:,2)
+ !
+ WHERE( PBMAP >= 0 .AND. ZWORK2 > 0)
+ PFMFLUXHDW = ZSURFRATIO * ZWORK * EXP(-1. * (TDTCUR%XTIME - PBMAP) / ZWORK2)
+ ELSEWHERE
+ PFMFLUXHDW = ZSURFRATIO * ZWORK
+ END WHERE
+ ! Minimal flux injection 0.001*Phie
+ WHERE(PFMFLUXHDW < .01 * ZWORK) PFMFLUXHDW = ZSURFRATIO * .01 * ZWORK
+ END SELECT
+
+ ! Check if heat flux if below Available sensible energy
+ WHERE ( PFMAWC < ZMINENERGY )
+ PFMFLUXHDW = 0.
+ END WHERE
+
+ !
+ WHERE ( PFMAWC < PFMFLUXHDW * PATMDT)
+ PFMFLUXHDW = PFMAWC / PATMDT
+ END WHERE
+
+ ! Remove injected energy from Available energy
+ PFMAWC(:,:,:) = PFMAWC(:,:,:) - PFMFLUXHDW(:,:,:) * PATMDT
+
+END SUBROUTINE FIRE_HEATFLUXES
+
+
+SUBROUTINE FIRE_VERTICALFLUXDISTRIB( PFMFLUXHDH, PFMFLUXHDW, PRTHS, PRRS, PSFTS, PEXNREF, PRHODJ, PRT, PRHODREF )
+ !!**** *FIRE_VERTICALFLUXDISTRIB* - Fire model vertical distribution of heat fluxes
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute vertical distribution of sensible and latent heat fluxes
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! See A. Costes PhD [2021]
+ !!
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_CST
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !USE MODI_FIRE_MODEL
+ USE MODD_GRID_n, ONLY : XZS, XZZ
+ USE MODD_NSV
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ ! Heat Flux in
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMFLUXHDH ! Surface sensible heat flux (W/m2), fire grid
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFMFLUXHDW ! Surface water flux (kg/m2/s), fire grid
+
+ ! Sources
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS ! Potential temperature increment (K kg/s)
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! Water content increment (kg/s)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSFTS ! smoke flux (kg/kg/m2/s)
+
+ ! Other fields
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density times atm cell volume rho*J
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Water content (kg/kg)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! reference profile of density
+
+ !* 0.2 declarations of local variables
+ ! Heat Flux
+ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2)) :: ZFLUXATMH ! Sensible heat flux on atm grid
+ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2)) :: ZFLUXATMW ! Latent heat flux on atm grid
+ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZCPH ! Cph (only gaz considered for virtual temperatures)
+ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZRVT ! water vapor mixing ratio
+ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZFLUXCOEF ! distributed coefficient
+ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZHZ ! Flux point height
+ !
+
+ INTEGER :: IKB, IKE, IKU
+ INTEGER :: IZMAX ! index of max injection height
+ REAL :: ZZMAXLOCAL ! local max injection height
+ REAL :: ZINJECTTMP ! total injecction before correction
+
+ ! loop, tests
+ INTEGER :: JI, JJ, JK, JKK
+ INTEGER :: JSV
+ !----------------------------------------------------------------------------------------------
+ !
+ !* 1. Set Flux on atm grid
+
+ ! Mean sensible heat flux from fire grid to atm grid
+ ZFLUXATMH(:,:) = SUM(PFMFLUXHDH(:,:,:),DIM=3) / (NREFINX * NREFINY)
+
+ ! Mean latent heat flux from fire grid to atm grid
+ ZFLUXATMW(:,:) = SUM(PFMFLUXHDW(:,:,:),DIM=3) / (NREFINX * NREFINY)
+
+ !* 2. Compute Cph
+
+ ! check humidity
+ IF(SIZE(PRT,4) /= 0) THEN
+ ZRVT(:,:,:) = PRT(:,:,:,1)
+ ELSE
+ ZRVT(:,:,:) = 0.
+ END IF
+
+ ! todo: add liquid and solid contribution to Cph
+ ! see dyn_sources.f90 for example
+ ! Cph = Cpd + Cpv * rv
+ ZCPH = XCPD + XCPV * ZRVT
+
+ !* 3. Compute distributed fluxes
+
+ ! top index
+ IKU = SIZE(PRTHS,3)
+ IKE = IKU - 1
+ ! bottom physical index
+ IKB = 2
+
+ ! Ensure zf > 0
+ IF (XFLUXZEXT <= 0) XFLUXZEXT = 1.
+
+ ! get height instead of altitude
+ DO JK=1,IKU
+ DO JJ=1,SIZE(PRTHS,2)
+ DO JI=1,SIZE(PRTHS,1)
+ ZHZ(JI,JJ,JK) = XZZ(JI,JJ,JK) - XZZ(JI,JJ,IKB)
+ END DO
+ END DO
+ END DO
+
+ ! compute distribution
+ DO JJ=1,SIZE(PRTHS,2)
+ DO JI=1,SIZE(PRTHS,1)
+ ! Ensure 0 < zmax < ztop-1 domain
+ ZZMAXLOCAL = MAX(1E-1,MIN(ZHZ(JI,JJ,IKE),XFLUXZMAX))
+ DO JK=IKB,IKU
+ IF (ZHZ(JI,JJ,JK) < ZZMAXLOCAL) THEN
+ ! Flux distribution coef
+ ! Coef = (exp(-z(k)/zf) - exp(- min(z(k+1),zmax)/zf)) / ((1 - exp(-zmax/zf))*(z(k+1)-z(k)))
+ ! sensible
+ ZFLUXCOEF(JI,JJ,JK) = (EXP(-1.*ZHZ(JI,JJ,JK)/XFLUXZEXT) - EXP(-1.*MIN(ZHZ(JI,JJ,JK+1),ZZMAXLOCAL)/XFLUXZEXT)) / &
+ ((1. - EXP(-1.*ZZMAXLOCAL/XFLUXZEXT))*(ZHZ(JI,JJ,JK+1)-ZHZ(JI,JJ,JK)))
+ ELSE
+ ZFLUXCOEF(JI,JJ,JK) = 0.
+ END IF
+ END DO
+ END DO
+ END DO
+
+ !* 4. Set theta and rv sources
+
+ ! sensible
+ ! RTHS += rho*J*Psi_h / (Pi_ref * Cph)
+ DO JJ=1,SIZE(PRTHS,2)
+ DO JI=1,SIZE(PRTHS,1)
+ DO JK=IKB,IKU
+ PRTHS(JI,JJ,JK) = PRTHS(JI,JJ,JK) + PRHODJ(JI,JJ,JK) * ZFLUXATMH(JI,JJ) * ZFLUXCOEF(JI,JJ,JK) &
+ / (PEXNREF(JI,JJ,JK) * ZCPH(JI,JJ,JK))
+ END DO
+ END DO
+ END DO
+
+ ! latent
+ ! RRS += rho*J*Psi_w / rho_ref
+ IF(SIZE(PRT,4) /= 0) THEN
+ DO JJ=1,SIZE(PRTHS,2)
+ DO JI=1,SIZE(PRTHS,1)
+ DO JK=IKB,IKU
+ PRRS(JI,JJ,JK,1) = PRRS(JI,JJ,JK,1) + PRHODJ(JI,JJ,JK) * ZFLUXATMW(JI,JJ) * ZFLUXCOEF(JI,JJ,JK) / PRHODREF(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+ END IF
+
+
+ !* 5. Set smoke source
+ ! :tmp: smoke flux is proportional to sensible heat flux
+ DO JSV=1,NSV_FIRE
+ PSFTS(:,:,NSV_FIREBEG-1+JSV) = ZFLUXATMH / 1E5
+ END DO
+
+END SUBROUTINE FIRE_VERTICALFLUXDISTRIB
+
+
+SUBROUTINE FIRE_READFUEL( TPFILE, PFIREFUELMAP, PFMIGNITION, PFMWALKIG )
+ !!**** *FIRE_READFUEL* - Fire model read FuelMap.nc file
+ !!
+ !! PURPOSE
+ !! -------
+ !! Read FuelMap.nc file to get fuel properties
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODD_CONF, ONLY : NVERB
+ USE MODD_FIELD
+ USE MODD_IO, ONLY: TFILEDATA
+ USE MODD_LUNIT_n, ONLY: TLUOUT
+ USE MODE_FIELD
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+ use NETCDF, ONLY: NF90_FLOAT
+ USE MODE_IO_FIELD_READ,ONLY: IO_Field_read
+ USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+ REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PFIREFUELMAP ! Fuel map
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMIGNITION ! Ignition map
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWALKIG ! Walking Ignition map
+
+ !* 0.2 declarations of local variables
+
+ REAL, DIMENSION(SIZE(PFIREFUELMAP,1),SIZE(PFIREFUELMAP,2),SIZE(PFIREFUELMAP,3)) :: ZWORK ! Working array
+
+ CHARACTER(LEN=6) :: YFUELNAME
+ INTEGER :: IID ! File management variable
+ INTEGER :: IRESP ! Return code of FM routines
+ INTEGER :: IGRID ! C-grid indicator in LFIFM file
+ INTEGER :: ILENCH ! Length of comment string in LFIFM file
+ CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+ INTEGER :: ILUOUT ! Logical unit number for the output listing
+ INTEGER :: IIU, IJU ! max array size
+ TYPE(TFILEDATA),POINTER :: TFUELFILE => NULL() ! FuelMap file
+ TYPE(TFIELDDATA) :: TZFIELD ! Field type
+ ! loop, tests
+ INTEGER :: JFUEL
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Get logical number for Outputlisting
+
+ ILUOUT = TLUOUT%NLU
+
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ WRITE(UNIT=ILUOUT,FMT=*) '**** Fire model fuel extraction ****'
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+
+ !* 2. Open file
+
+ CALL IO_FILE_ADD2LIST( TFUELFILE, 'FuelMap', 'MNH', 'READ', HFORMAT='NETCDF4' )
+ CALL IO_File_open( TFUELFILE )
+
+ TFUELFILE%NLFITYPE = 0
+
+ !* 3. Read fuels properties
+
+ CALL FIND_FIELD_ID_FROM_MNHNAME( 'UT', IID, IRESP )
+ TZFIELD = TFIELDLIST(IID)
+
+ DO JFUEL = 1, 22
+ WRITE(YFUELNAME,'(A4,I2.2)')'Fuel',JFUEL
+ WRITE(UNIT=ILUOUT,FMT=*) 'Extract ', YFUELNAME
+ ! change field properties
+ TZFIELD%CMNHNAME = YFUELNAME
+ TZFIELD%CSTDNAME = YFUELNAME
+ TZFIELD%NDIMS = 3
+ TZFIELD%NTYPE = NF90_FLOAT
+ TZFIELD%LTIMEDEP = .FALSE.
+ TZFIELD%NGRID = 4
+ ! Import data from file
+ CALL IO_Field_read( TFUELFILE, TZFIELD, PFIREFUELMAP(:,:,:,JFUEL) )
+ END DO
+
+ !* 4. read ignition map file
+
+ WRITE(UNIT=ILUOUT,FMT=*) 'Extract Ignition'
+
+ ! change field properties
+ TZFIELD%CMNHNAME = 'Ignition'
+ TZFIELD%CSTDNAME = 'Ignition'
+
+ ! Import data from file
+ CALL IO_Field_read( TFUELFILE, TZFIELD, PFMIGNITION )
+
+ !* 5. read walking ignition map file
+
+ WRITE(UNIT=ILUOUT,FMT=*) 'Extract Walking Ignition'
+
+ ! change field properties
+ TZFIELD%CMNHNAME = 'WalkingIgnition'
+ TZFIELD%CSTDNAME = 'WalkingIgnition'
+
+ ! Import data from file
+ CALL IO_Field_read( TFUELFILE, TZFIELD, PFMWALKIG )
+
+ !* 6. close file
+
+ CALL IO_File_close( TFUELFILE )
+ WRITE(UNIT=ILUOUT,FMT=*) '*************** Done ***************'
+
+END SUBROUTINE FIRE_READFUEL
+
+
+SUBROUTINE FIRE_READBMAP(TPFILE, PBMAP)
+ !!**** *FIRE_NOWINDROS* - Fire model read bmap file
+ !!
+ !! PURPOSE
+ !! -------
+ !! Read Bmap file
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODD_CONF, ONLY : NVERB
+ USE MODD_FIELD
+ USE MODD_IO, ONLY: TFILEDATA
+ USE MODD_LUNIT_n, ONLY: TLUOUT
+ USE MODE_FIELD
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+ use NETCDF, only: NF90_FLOAT
+ USE MODE_IO_FIELD_READ,ONLY: IO_Field_read
+ USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Bmap
+
+ !* 0.2 declarations of local variables
+
+ CHARACTER(LEN=6) :: YFUELNAME
+ INTEGER :: IID ! File management variable
+ INTEGER :: IRESP ! Return code of FM routines
+ INTEGER :: IGRID ! C-grid indicator in LFIFM file
+ INTEGER :: ILENCH ! Length of comment string in LFIFM file
+ CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+ INTEGER :: ILUOUT ! Logical unit number for the output listing
+ INTEGER :: IIU, IJU ! max array size
+ TYPE(TFILEDATA),POINTER :: TFUELFILE => NULL() ! FuelMap file
+ TYPE(TFIELDDATA) :: TZFIELD ! Field type
+ ! loop, tests
+ INTEGER :: JFUEL
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Get logical number for Outputlisting
+
+ ILUOUT = TLUOUT%NLU
+
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ WRITE(UNIT=ILUOUT,FMT=*) '**** Fire model BMap extraction ****'
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+
+ !* 2. Open file
+
+ CALL IO_FILE_ADD2LIST( TFUELFILE, CBMAPFILE, 'MNH', 'READ', HFORMAT='NETCDF4' )
+ CALL IO_File_open( TFUELFILE )
+
+ TFUELFILE%NLFITYPE = 0
+
+ !* 4. read Burning map file
+
+ WRITE(UNIT=ILUOUT,FMT=*) 'Extract BMap'
+
+ CALL FIND_FIELD_ID_FROM_MNHNAME( 'UT', IID, IRESP )
+ TZFIELD = TFIELDLIST(IID)
+ ! changes properties
+ TZFIELD%CMNHNAME = 'BMAP'
+ TZFIELD%CSTDNAME = 'BMAP'
+ TZFIELD%NDIMS = 3
+ TZFIELD%NTYPE = NF90_FLOAT
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%NGRID = 1
+
+ ! Import data from file
+ CALL IO_Field_read( TFUELFILE, TZFIELD, PBMAP )
+
+ !* 5. Close file
+
+ CALL IO_File_close( TFUELFILE )
+
+ WRITE(UNIT=ILUOUT,FMT=*) '*************** Done ***************'
+
+END SUBROUTINE FIRE_READBMAP
+
+
+SUBROUTINE FIRE_RK( PLSPHI, PLSPHI1, PGRADLSPHIX, PGRADLSPHIY, PFIRERW, PFIREDT )
+ !!**** *FIRE_RK * - routine to call the specialized advection routines for phi
+ !!
+ !! PURPOSE
+ !! -------
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !!
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 27/11/2019
+ !!
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ USE MODE_ll
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
+ USE MODD_PARAMETERS, ONLY : JPVEXT
+ USE MODD_CONF, ONLY : NHALO
+ !
+ USE MODI_GET_HALO
+ USE MODE_MPPDB
+ USE MODD_FIRE
+ USE MODI_FIRE_MODEL, ONLY: FIRE_GRADPHI, FIRE_LSDIFFU
+ use MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of dummy arguments :
+ !
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function at time t
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSPHI1 ! Level Set function at time t+dtfire
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIX ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PGRADLSPHIY ! Grad of Phi on y direction
+ !
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIRERW ! Rate of spread with wind
+ !
+ REAL, INTENT(IN) :: PFIREDT ! Fire time step dtfire
+ !
+ !* 0.2 declarations of local variables
+ !
+ REAL, DIMENSION(SIZE(PLSPHI,1),SIZE(PLSPHI,2),SIZE(PLSPHI,3)) :: ZLSPHIRK ! Intermediate Guesses inside the RK loop
+ !
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZGRADPHIXRK ! RK loop gradient of phi in x direction
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZGRADPHIYRK ! RK loop gradient of phi in y direction
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPHIDIFFRKX ! RK loop laplacian of phi in x direction
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPHIDIFFRKY ! RK loop laplacian of phi in y direction
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUT ! Butcher array coefficients
+ ! at the RK sub time step
+ REAL, DIMENSION(:), ALLOCATABLE :: ZBUTS! Butcher array coefficients
+ ! at the end of the RK loop
+
+ TYPE(LIST_ll), POINTER :: TZFIELDFIRE_ll ! list of fields to exchange
+ INTEGER :: INBVAR
+ INTEGER :: IIU, IJU, IKU ! array sizes
+
+ ! Momentum tendencies due to advection
+ INTEGER :: ISPL ! Number of RK splitting loops
+ INTEGER :: JI, JS ! Loop index
+ !
+ INTEGER :: IINFO_ll ! return code of parallel routine
+ TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange
+ !
+ REAL :: XPRECISION
+ REAL, DIMENSION(2) :: ZGRADTIME1, ZGRADTIME2
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. INITIALIZATION
+ ! --------------------
+ !
+ IIU=SIZE(PLSPHI,1)
+ IJU=SIZE(PLSPHI,2)
+ IKU=SIZE(PLSPHI,3)
+ !
+ SELECT CASE (NFIRE_RK_ORDER)
+ CASE(1)
+ ISPL = 1
+
+ CASE(2)
+ ISPL = 2
+
+ CASE(3)
+ ISPL = 3
+
+ CASE(4)
+ ISPL = 4
+
+ CASE(5)
+ ISPL = 5
+
+ CASE(6)
+ ISPL = 6
+
+ CASE DEFAULT
+ PRINT *,'ERROR: UNKNOWN NFIRE_RK_ORDER'
+ CALL ABORT()
+ END SELECT
+ !
+ ALLOCATE(ZBUT(ISPL-1,ISPL-1))
+ ALLOCATE(ZBUTS(ISPL))
+ !
+ SELECT CASE (NFIRE_RK_ORDER)
+ CASE(1)
+ ZBUTS = (/ 1. /)
+
+ CASE(2)
+ ZBUTS = (/ 0. , 1. /)
+ ZBUT(1,1) = 3./4.
+
+ CASE(3)
+ ZBUTS = (/ 1./6. , 1./6. , 2./3. /)
+ ZBUT(1,1) = 1.
+ ZBUT(1,2) = 0.
+ ZBUT(2,1) = 1./4.
+ ZBUT(2,2) = 1./4.
+
+ CASE(4)
+ ZBUTS = (/ 1./6. , 1./3. , 1./3. , 1./6./)
+ ZBUT = 0.
+ ZBUT(1,1) = 1./2.
+ ZBUT(2,2) = 1./2.
+ ZBUT(3,3) = 1.
+
+ CASE(5)
+ ZBUTS = (/ 1./4. , 0. , 0. , 0. , 3./4. /)
+ ZBUT = 0.
+ ZBUT(1,1) = 1./7.
+ ZBUT(2,2) = 3./16.
+ ZBUT(3,3) = 1./3.
+ ZBUT(4,4) = 2./3.
+
+ CASE(6)
+ ZBUTS= (/ 7./90. , 0. , 16./45. , 2./15. , 16./45. , 7./90. /)
+ ZBUT= 0.
+ ZBUT(1,1) = 1./4.
+ ZBUT(2,1) = 1./8.
+ ZBUT(2,2) = 1./8.
+ ZBUT(3,1) = 0
+ ZBUT(3,2) = -1./2.
+ ZBUT(3,3) = 1
+ ZBUT(4,1) = 3./16.
+ ZBUT(4,2) = 0
+ ZBUT(4,3) = 0
+ ZBUT(4,4) = 9./16.
+ ZBUT(5,1) = -3./7.
+ ZBUT(5,2) = 2./7.
+ ZBUT(5,3) = 12./7.
+ ZBUT(5,4) = -12./7.
+ ZBUT(5,5) = 8./7.
+ END SELECT
+ !
+ ALLOCATE(ZGRADPHIXRK(SIZE(PLSPHI,1),SIZE(PLSPHI,2),SIZE(PLSPHI,3),ISPL))
+ ALLOCATE(ZGRADPHIYRK(SIZE(PLSPHI,1),SIZE(PLSPHI,2),SIZE(PLSPHI,3),ISPL))
+ ALLOCATE(ZPHIDIFFRKX(SIZE(PLSPHI,1),SIZE(PLSPHI,2),SIZE(PLSPHI,3),ISPL))
+ ALLOCATE(ZPHIDIFFRKY(SIZE(PLSPHI,1),SIZE(PLSPHI,2),SIZE(PLSPHI,3),ISPL))
+ !
+ PLSPHI1 = PLSPHI
+ !
+ !* 2. Wind guess before RK loop
+ ! -------------------------------
+ ZLSPHIRK = PLSPHI
+
+ NULLIFY(TZFIELDFIRE_ll)
+ CALL ADD3DFIELD_ll(TZFIELDFIRE_ll, ZLSPHIRK, 'MODEL_n::ZLSPHIRK')
+ !
+ ZGRADPHIXRK(:,:,:,:) = 0.
+ ZGRADPHIYRK(:,:,:,:) = 0.
+ ZPHIDIFFRKX(:,:,:,:) = 0.
+ ZPHIDIFFRKY(:,:,:,:) = 0.
+ !
+ !* 3. BEGINNING of Runge-Kutta loop
+ ! -----------------------------------
+ !
+ DO JS = 1, ISPL
+ CALL UPDATE_HALO_ll( TZFIELDFIRE_ll, IINFO_ll )
+ !* 4. Advection with WENO
+ ! -------------------------
+
+ IF (JS > 1) THEN
+ CALL SECOND_MNH2( ZGRADTIME1 )
+ CALL FIRE_GRADPHI( ZLSPHIRK, ZGRADPHIXRK(:,:,:,JS), ZGRADPHIYRK(:,:,:,JS) )
+ CALL SECOND_MNH2( ZGRADTIME2 )
+ XGRADPERF = XGRADPERF + ZGRADTIME2 - ZGRADTIME1
+ XPROPAGPERF = XPROPAGPERF - (ZGRADTIME2 - ZGRADTIME1)
+ ELSE
+ ! Use already computed gradients
+ ZGRADPHIXRK(:,:,:,JS) = PGRADLSPHIX(:,:,:)
+ ZGRADPHIYRK(:,:,:,JS) = PGRADLSPHIY(:,:,:)
+ END IF
+
+ CALL FIRE_LSDIFFU( ZLSPHIRK, ZPHIDIFFRKX(:,:,:,JS), ZPHIDIFFRKY(:,:,:,JS) )
+
+ NULLIFY(TZFIELDS4_ll)
+
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZGRADPHIXRK(:,:,:,JS), 'MODEL_n::ZGRADPHIXRK' )
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZGRADPHIYRK(:,:,:,JS), 'MODEL_n::ZGRADPHIYRK' )
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZPHIDIFFRKX(:,:,:,JS), 'MODEL_n::ZPHIDIFFRKX' )
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZPHIDIFFRKY(:,:,:,JS), 'MODEL_n::ZPHIDIFFRKY' )
+ CALL UPDATE_HALO_ll( TZFIELDS4_ll, IINFO_ll )
+ CALL CLEANLIST_ll( TZFIELDS4_ll )
+
+ IF ( JS /= ISPL ) THEN
+ ZLSPHIRK = PLSPHI
+ DO JI = 1, JS
+ !
+ ! Intermediate guesses inside the RK loop
+ !
+ ZLSPHIRK(:,:,:) = ZLSPHIRK(:,:,:) + ZBUT(JS,JI) * PFIREDT * ( &
+ PFIRERW * SQRT(ZGRADPHIXRK(:,:,:,JS)**2 + ZGRADPHIYRK(:,:,:,JS)**2) + &
+ XLSDIFFUSION * (ZPHIDIFFRKX(:,:,:,JS) + ZPHIDIFFRKY(:,:,:,JS)))
+
+ END DO
+
+ WHERE(ZLSPHIRK > 1) ZLSPHIRK = 1.
+ ! diffusion protection
+ WHERE(PFIRERW == 0.) ZLSPHIRK = 0.
+
+ ELSE
+ !
+ ! Guesses at the end of the RK loop
+ !
+ DO JI = 1, ISPL
+ PLSPHI1(:,:,:) = PLSPHI1(:,:,:) + ZBUTS(JI) * PFIREDT * ( &
+ PFIRERW * SQRT(ZGRADPHIXRK(:,:,:,JI)**2 + ZGRADPHIYRK(:,:,:,JI)**2) + &
+ XLSDIFFUSION * (ZPHIDIFFRKX(:,:,:,JS) + ZPHIDIFFRKY(:,:,:,JS)))
+ END DO
+ ! diffusion protection
+ WHERE(PFIRERW == 0.) PLSPHI1 = 0.
+
+ END IF
+ ! End of the RK loop
+ END DO
+ !
+ DEALLOCATE(ZBUT, ZBUTS, ZGRADPHIXRK, ZGRADPHIYRK,ZPHIDIFFRKX,ZPHIDIFFRKY)
+ CALL CLEANLIST_ll( TZFIELDFIRE_ll )
+
+END SUBROUTINE FIRE_RK
+
+
+SUBROUTINE FIRE_WENO_1( PLSPHI2D, PGRADLSPHIX2D, PGRADLSPHIY2D, PGRADMASKX, PGRADMASKY )
+ !!**** *FIRE_WENO_1* - Fire model computation of Level set function gradient
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute gradient on x and y direcctions for level set function
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! WENO1
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+ !
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !USE MODI_FIRE_MODEL
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIX2D ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIY2D ! Grad of Phi on y direction
+ !
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKX ! mask value x
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKY ! mask value y
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: ILU, IMU
+ INTEGER :: JL, JM
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute 1st order upwind gradient
+
+ PGRADLSPHIX2D = 0.
+ PGRADLSPHIY2D = 0.
+
+ ILU = SIZE(PLSPHI2D,1)
+ IMU = SIZE(PLSPHI2D,2)
+
+ ! dY = (Y(i) - Y(i-1)) / dx if Y(i+1) <= Y(i-1)
+ ! dY = (Y(i+1) - Y(i)) / dx if Y(i+1) > Y(i-1)
+ PGRADLSPHIX2D(2:ILU-1,:) = (PLSPHI2D(3:ILU,:) -PLSPHI2D(2:ILU-1,:)) / XFIREMESHSIZE(1) * (.5 + SIGN(.5,PGRADMASKX(2:ILU-1,:)))+&
+ (PLSPHI2D(2:ILU-1,:) - PLSPHI2D(1:ILU-2,:)) / XFIREMESHSIZE(1) * (.5 - SIGN(.5,PGRADMASKX(2:ILU-1,:)))
+ !
+ PGRADLSPHIY2D(:,2:IMU-1) = (PLSPHI2D(:,3:IMU) -PLSPHI2D(:,2:IMU-1)) / XFIREMESHSIZE(2) * (.5 + SIGN(.5,PGRADMASKY(:,2:IMU-1)))+&
+ (PLSPHI2D(:,2:IMU-1) - PLSPHI2D(:,1:IMU-2)) / XFIREMESHSIZE(2) * (.5 - SIGN(.5,PGRADMASKY(:,2:IMU-1)))
+ !
+
+END SUBROUTINE FIRE_WENO_1
+
+
+SUBROUTINE FIRE_GRADMASK( PLSPHI2D, PGRADMASKX, PGRADMASKY, KMASKORDER )
+ !!**** *FIRE_GRADMASK* - Fire model computation of Level set function gradient
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute gradient on x and y direcctions for level set function
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! Centered 2nd/4th order scheme
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !USE MODI_FIRE_MODEL
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADMASKX ! mask value x
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADMASKY ! mask value y
+ INTEGER, INTENT(IN) :: KMASKORDER ! Difference order
+ !
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: ILU, IMU
+ INTEGER :: JL, JM
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Default value
+
+ ILU = SIZE(PLSPHI2D,1)
+ IMU = SIZE(PLSPHI2D,2)
+
+ PGRADMASKX(:,:) = 0.
+ PGRADMASKY(:,:) = 0.
+
+ SELECT CASE(KMASKORDER)
+ CASE(2)
+ ! Compute 2nd order centered difference for mask value
+ PGRADMASKX(2:ILU-1,:) = PLSPHI2D(3:ILU,:) - PLSPHI2D(1:ILU-2,:)
+ PGRADMASKY(:,2:IMU-1) = PLSPHI2D(:,3:IMU) - PLSPHI2D(:,1:IMU-2)
+
+ CASE(4)
+ ! Compute 4nd order centered difference for mask value
+ PGRADMASKX(3:ILU-2,:) = 8.*(PLSPHI2D(4:ILU-1,:) - PLSPHI2D(2:ILU-3,:)) - (PLSPHI2D(5:ILU,:) - PLSPHI2D(1:ILU-4,:))
+ PGRADMASKY(:,3:IMU-2) = 8.*(PLSPHI2D(:,4:IMU-1) - PLSPHI2D(:,2:IMU-3)) - (PLSPHI2D(:,5:IMU) - PLSPHI2D(:,1:IMU-4))
+ ! Compute 2nd order on bounds
+ ! west
+ PGRADMASKX(2,:) = PLSPHI2D(3,:) - PLSPHI2D(1,:)
+ ! east
+ PGRADMASKX(ILU-1,:) = PLSPHI2D(ILU,:) - PLSPHI2D(ILU-2,:)
+ ! south
+ PGRADMASKY(:,2) = PLSPHI2D(:,3) - PLSPHI2D(:,1)
+ ! north
+ PGRADMASKY(:,IMU-1) = PLSPHI2D(:,IMU) - PLSPHI2D(:,IMU-2)
+
+ CASE DEFAULT
+ ! Compute 2nd order centered difference for mask value
+ PGRADMASKX(2:ILU-1,:) = PLSPHI2D(3:ILU,:) - PLSPHI2D(1:ILU-2,:)
+ PGRADMASKY(:,2:IMU-1) = PLSPHI2D(:,3:IMU) - PLSPHI2D(:,1:IMU-2)
+ END SELECT
+
+END SUBROUTINE FIRE_GRADMASK
+
+
+SUBROUTINE FIRE_WENO_3( PLSPHI2D, PGRADLSPHIX2D, PGRADLSPHIY2D, PGRADMASKX, PGRADMASKY )
+ !!**** *FIRE_WENO_3* - Fire model computation of Level set function gradient
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute gradient on x and y direcctions for level set function
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! WENO3
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+ !
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !USE MODI_FIRE_MODEL
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIX2D ! Grad of Phi on x direction
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGRADLSPHIY2D ! Grad of Phi on y direction
+ !
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKX ! mask value x
+ REAL, DIMENSION(:,:), INTENT(IN) :: PGRADMASKY ! mask value y
+
+ !* 0.2 declarations of local variables
+
+ ! Phi reconstruction
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHINEG ! Phi(i+1/2)-
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHIPOS ! Phi(i+1/2)+
+
+ ! Intermediate reconstruction
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHINEG1, ZPHINEG2 ! Phi(i+1/2)- (1) and (2)
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHIPOS1, ZPHIPOS2 ! Phi(i+1/2)+ (1) and (2)
+
+ ! Smoothness indicator
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZBETA1NEG, ZBETA2NEG ! beta1-, beta2-
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZBETA1POS, ZBETA2POS ! beta1+, beta2+
+
+ ! Weno weights
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZOMEGA1NEG, ZOMEGA2NEG ! omega1-, omega2-
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZOMEGA1POS, ZOMEGA2POS ! omega1+, omega2+
+
+ ! standard weights
+ REAL, PARAMETER :: ZGAMMA1 = 1./3.
+ REAL, PARAMETER :: ZGAMMA2 = 2./3.
+ !
+ REAL, PARAMETER :: ZEPS = 1.0E-15
+
+ INTEGER :: ILU, IMU
+ INTEGER :: JL, JM
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Default value for fields
+
+ ! Phi reconstruction
+ ZPHINEG = 0.
+ ZPHIPOS = 0.
+
+ ! Intermediate reconstruction
+ ZPHINEG1 = 0.
+ ZPHINEG2 = 0.
+ ZPHIPOS1 = 0.
+ ZPHIPOS2 = 0.
+
+ ! Smoothness indicator
+ ZBETA1NEG = 0.
+ ZBETA2NEG = 0.
+ ZBETA1POS = 0.
+ ZBETA2POS = 0.
+
+ ! Weno weights
+ ZOMEGA1NEG = 0.
+ ZOMEGA2NEG = 0.
+ ZOMEGA1POS = 0.
+ ZOMEGA2POS = 0.
+
+ ! Out gradients
+ PGRADLSPHIX2D = 0.
+ PGRADLSPHIY2D = 0.
+
+ ! get array sizes
+ ILU = SIZE(PLSPHI2D,1)
+ IMU = SIZE(PLSPHI2D,2)
+
+ !* 2. Compute gradient for x direction
+ !* 2.1 Compute phi(i+1/2)-
+
+ ! phi(i+1/2)- (1) = 3/2 * phi_i - 1/2 * phi(i-1)
+ ZPHINEG1(2:ILU-1,:) = -.5 * PLSPHI2D(1:ILU-2,:) + 1.5 * PLSPHI2D(2:ILU-1,:)
+ ! phi(i+1/2)- (2) = 1/2 * phi_i + 1/2 * phi(i+1)
+ ZPHINEG2(2:ILU-1,:) = .5 * PLSPHI2D(2:ILU-1,:) + .5 * PLSPHI2D(3:ILU,:)
+
+ ! Overshot smoothing
+ WHERE (ZPHINEG1 > 1.) ZPHINEG1 = 1.
+ WHERE (ZPHINEG1 < 0.) ZPHINEG1 = 0.
+ ! ZPHINEG2 doesn't need smoothing because overshoot can not exist
+
+ !* 2.2 Compute phi(i-1/2)+
+
+ ! phi(i-1/2)+ (1) = 3/2 * phi_i - 1/2 * phi(i+1)
+ ZPHIPOS1(2:ILU-1,:) = -.5 * PLSPHI2D(3:ILU,:) + 1.5 * PLSPHI2D(2:ILU-1,:)
+ ! phi(i-1/2)+ (2) = 1/2 * phi_i + 1/2 * phi(i-1)
+ ZPHIPOS2(2:ILU-1,:) = .5 * PLSPHI2D(2:ILU-1,:) + .5 * PLSPHI2D(1:ILU-2,:)
+
+ ! Overshot smoothing
+ WHERE (ZPHIPOS1 > 1.) ZPHIPOS1 = 1.
+ WHERE (ZPHIPOS1 < 0.) ZPHIPOS1 = 0.
+ ! ZPHIPOS2 doesn't need smoothing because overshoot can not exist
+
+ !* 2.3 Compute beta-
+
+ ! beta(1)- = (phi_i - phi_(i-1))^2
+ ZBETA1NEG(2:ILU-1,:) = (PLSPHI2D(2:ILU-1,:) - PLSPHI2D(1:ILU-2,:))**2
+ ! beta(2)- = (phi_(i+1) - phi_i)^2
+ ZBETA2NEG(2:ILU-1,:) = (PLSPHI2D(3:ILU,:) - PLSPHI2D(2:ILU-1,:))**2
+
+ !* 2.4 Compute beta+
+
+ ! beta(1)- = (phi_i - phi_(i+1))^2
+ ZBETA1POS(2:ILU-1,:) = (PLSPHI2D(2:ILU-1,:) - PLSPHI2D(3:ILU,:))**2
+ ! beta(2)- = (phi_(i-1) - phi_i)^2
+ ZBETA2POS(2:ILU-1,:) = (PLSPHI2D(1:ILU-2,:) - PLSPHI2D(2:ILU-1,:))**2
+
+ !* 2.5 Compute omega-
+
+ ZOMEGA1NEG(2:ILU-1,:) = ZGAMMA1 / (ZEPS + ZBETA1NEG(2:ILU-1,:))**2
+ ZOMEGA2NEG(2:ILU-1,:) = ZGAMMA2 / (ZEPS + ZBETA2NEG(2:ILU-1,:))**2
+
+ !* 2.6 Compute omega+
+
+ ZOMEGA1POS(2:ILU-1,:) = ZGAMMA1 / (ZEPS + ZBETA1POS(2:ILU-1,:))**2
+ ZOMEGA2POS(2:ILU-1,:) = ZGAMMA2 / (ZEPS + ZBETA2POS(2:ILU-1,:))**2
+
+ !* 2.7 Compute reconstructions for phi+ and phi-
+
+ ! phi(i+1/2)-
+ ZPHINEG(2:ILU-1,:) = (ZOMEGA1NEG(2:ILU-1,:) * ZPHINEG1(2:ILU-1,:) + &
+ ZOMEGA2NEG(2:ILU-1,:) * ZPHINEG2(2:ILU-1,:)) / &
+ (ZOMEGA1NEG(2:ILU-1,:) + ZOMEGA2NEG(2:ILU-1,:))
+ !
+ ! phi(i-1/2)+
+ ZPHIPOS(2:ILU-1,:) = (ZOMEGA1POS(2:ILU-1,:) * ZPHIPOS1(2:ILU-1,:) + &
+ ZOMEGA2POS(2:ILU-1,:) * ZPHIPOS2(2:ILU-1,:)) / &
+ (ZOMEGA1POS(2:ILU-1,:) + ZOMEGA2POS(2:ILU-1,:))
+ !
+
+ ! Overshot smoothing
+ WHERE (ZPHINEG > 1.) ZPHINEG = 1.
+ WHERE (ZPHIPOS > 1.) ZPHIPOS = 1.
+ WHERE (ZPHINEG < 0.) ZPHINEG = 0.
+ WHERE (ZPHIPOS < 0.) ZPHIPOS = 0.
+
+ !* 2.8 Compute upwind gradient
+
+ ! - fluxes if mask < 0, ie phi_(i+1) < phi_(i-1)
+ ! fire spread from left to right
+ ! + fluxes if mask > 0, ie phi_(i+1) > phi_(i-1)
+ ! fire spread from right to left
+
+ PGRADLSPHIX2D(3:ILU-2,:) = ((ZPHINEG(3:ILU-2,:) - ZPHINEG(2:ILU-3,:)) * (.5 - SIGN(.5,PGRADMASKX(3:ILU-2,:))) + &
+ (ZPHIPOS(4:ILU-1,:) - ZPHIPOS(3:ILU-2,:)) * (.5 + SIGN(.5,PGRADMASKX(3:ILU-2,:))))/ &
+ XFIREMESHSIZE(1)
+ !
+
+ !* 3. Set default values for y direction
+
+ ! Phi reconstruction
+ ZPHINEG = 0.
+ ZPHIPOS = 0.
+
+ ! Intermediate reconstruction
+ ZPHINEG1 = 0.
+ ZPHINEG2 = 0.
+ ZPHIPOS1 = 0.
+ ZPHIPOS2 = 0.
+
+ ! Smoothness indicator
+ ZBETA1NEG = 0.
+ ZBETA2NEG = 0.
+ ZBETA1POS = 0.
+ ZBETA2POS = 0.
+
+ ! Weno weights
+ ZOMEGA1NEG = 0.
+ ZOMEGA2NEG = 0.
+ ZOMEGA1POS = 0.
+ ZOMEGA2POS = 0.
+
+ !* 4. Compute gradient for y direction
+
+ !* 4.1 Compute phi(i+1/2)-
+
+ ! phi(i+1/2)- (1) = 3/2 * phi_i - 1/2 * phi(i-1)
+ ZPHINEG1(:,2:IMU-1) = -.5 * PLSPHI2D(:,1:IMU-2) + 1.5 * PLSPHI2D(:,2:IMU-1)
+ ! phi(i+1/2)- (2) = 1/2 * phi_i + 1/2 * phi(i+1)
+ ZPHINEG2(:,2:IMU-1) = .5 * PLSPHI2D(:,2:IMU-1) + .5 * PLSPHI2D(:,3:IMU)
+
+ ! Overshot smoothing
+ WHERE (ZPHINEG1 > 1.) ZPHINEG1 = 1.
+ WHERE (ZPHINEG1 < 0.) ZPHINEG1 = 0.
+ ! ZPHINEG2 doesn't need smoothing because overshoot can not exist
+
+ !* 4.2 Compute phi(i-1/2)+
+
+ ! phi(i-1/2)+ (1) = 3/2 * phi_i - 1/2 * phi(i+1)
+ ZPHIPOS1(:,2:IMU-1) = -.5 * PLSPHI2D(:,3:IMU) + 1.5 * PLSPHI2D(:,2:IMU-1)
+ ! phi(i-1/2)+ (2) = 1/2 * phi_i + 1/2 * phi(i-1)
+ ZPHIPOS2(:,2:IMU-1) = .5 * PLSPHI2D(:,2:IMU-1) + .5 * PLSPHI2D(:,1:IMU-2)
+
+ ! Overshot smoothing
+ WHERE (ZPHIPOS1 > 1.) ZPHIPOS1 = 1.
+ WHERE (ZPHIPOS1 < 0.) ZPHIPOS1 = 0.
+ ! ZPHIPOS2 doesn't need smoothing because overshoot can not exist
+
+ !* 4.3 Compute beta-
+
+ ! beta(1)- = (phi_i - phi_(i-1))^2
+ ZBETA1NEG(:,2:IMU-1) = (PLSPHI2D(:,2:IMU-1) - PLSPHI2D(:,1:IMU-2))**2
+ ! beta(2)- = (phi_(i+1) - phi_i)^2
+ ZBETA2NEG(:,2:IMU-1) = (PLSPHI2D(:,3:IMU) - PLSPHI2D(:,2:IMU-1))**2
+
+ !* 4.4 Compute beta+
+
+ ! beta(1)- = (phi_i - phi_(i+1))^2
+ ZBETA1POS(:,2:IMU-1) = (PLSPHI2D(:,2:IMU-1) - PLSPHI2D(:,3:IMU))**2
+ ! beta(2)- = (phi_(i-1) - phi_i)^2
+ ZBETA2POS(:,2:IMU-1) = (PLSPHI2D(:,1:IMU-2) - PLSPHI2D(:,2:IMU-1))**2
+
+ !* 4.5 Compute omega-
+
+ ZOMEGA1NEG(:,2:IMU-1) = ZGAMMA1 / (ZEPS + ZBETA1NEG(:,2:IMU-1))**2
+ ZOMEGA2NEG(:,2:IMU-1) = ZGAMMA2 / (ZEPS + ZBETA2NEG(:,2:IMU-1))**2
+
+ !* 4.6 Compute omega+
+
+ ZOMEGA1POS(:,2:IMU-1) = ZGAMMA1 / (ZEPS + ZBETA1POS(:,2:IMU-1))**2
+ ZOMEGA2POS(:,2:IMU-1) = ZGAMMA2 / (ZEPS + ZBETA2POS(:,2:IMU-1))**2
+
+ !* 4.7 Compute reconstructions for phi+ and phi-
+
+ ! phi(i+1/2)-
+ ZPHINEG(:,2:IMU-1) = (ZOMEGA1NEG(:,2:IMU-1) * ZPHINEG1(:,2:IMU-1) + &
+ ZOMEGA2NEG(:,2:IMU-1) * ZPHINEG2(:,2:IMU-1)) / &
+ (ZOMEGA1NEG(:,2:IMU-1) + ZOMEGA2NEG(:,2:IMU-1))
+ !
+ ! phi(i-1/2)+
+ ZPHIPOS(:,2:IMU-1) = (ZOMEGA1POS(:,2:IMU-1) * ZPHIPOS1(:,2:IMU-1) + &
+ ZOMEGA2POS(:,2:IMU-1) * ZPHIPOS2(:,2:IMU-1)) / &
+ (ZOMEGA1POS(:,2:IMU-1) + ZOMEGA2POS(:,2:IMU-1))
+ !
+
+ ! Overshot smoothing
+ WHERE (ZPHINEG > 1.) ZPHINEG = 1.
+ WHERE (ZPHIPOS > 1.) ZPHIPOS = 1.
+ WHERE (ZPHINEG < 0.) ZPHINEG = 0.
+ WHERE (ZPHIPOS < 0.) ZPHIPOS = 0.
+
+ !* 4.8 Compute upwind gradient
+
+ ! - fluxes if mask < 0, ie phi_(i+1) < phi_(i-1)
+ ! fire spread from left to right
+ ! + fluxes if mask > 0, ie phi_(i+1) > phi_(i-1)
+ ! fire spread from right to left
+
+ PGRADLSPHIY2D(:,3:IMU-2) = ((ZPHINEG(:,3:IMU-2) - ZPHINEG(:,2:IMU-3)) * (.5 - SIGN(.5,PGRADMASKY(:,3:IMU-2))) + &
+ (ZPHIPOS(:,4:IMU-1) - ZPHIPOS(:,3:IMU-2)) * (.5 + SIGN(.5,PGRADMASKY(:,3:IMU-2))))/ &
+ XFIREMESHSIZE(2)
+
+END SUBROUTINE FIRE_WENO_3
+
+
+SUBROUTINE FIRE_LSDIFFU( PLSPHI, PLSDIFFUX, PLSDIFFUY )
+ !!**** *FIRE_LSDIFFU* - Fire model computation of Level set diffusion
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute diffusion on x and y direcctions for level set function
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! Centered 2nd order scheme
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+ USE MODD_FIELD_n, ONLY : XLSPHI2D, XLSDIFFUX2D, XLSDIFFUY2D
+ !
+ USE MODD_FIRE
+ !USE MODI_FIRE_MODEL
+ !
+ USE MODE_MPPDB
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSPHI ! Level Set function
+
+ !! Gradient of LS function
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSDIFFUX ! Laplacian of Phi on x direction
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSDIFFUY ! Laplacian of Phi on y direction
+ !
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: IIU, IJU ! atm mesh bounds
+ INTEGER :: ILU, IMU ! fire mesh bounds
+ INTEGER :: IKU ! fire 3rd dimension bounds
+ INTEGER :: IA,IB,II,IJ,IK,IL,IM ! Index for conversions
+ ! loop
+ INTEGER :: JI,JJ,JK ! index for atm mesh loop i,j,k
+ INTEGER :: JL,JM ! index for fire mesh loop l,m
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Allocate 2D array with fire grid bounds
+
+ ! get atm mesh bounds
+ IIU = SIZE(PLSPHI,1)
+ IJU = SIZE(PLSPHI,2)
+ IKU = SIZE(PLSPHI,3) ! NREFINX * NREFINY
+
+ ILU = SIZE(XLSPHI2D,1)
+ IMU = SIZE(XLSPHI2D,2)
+
+ ! Default values
+ PLSDIFFUX(:,:,:) = 0.
+ PLSDIFFUY(:,:,:) = 0.
+
+ !* 2. Convert LS function Phi from 3d to 2d format
+
+ ! get l and m to find PHI2D(l,m) = PHI3D(i,j,k)
+ DO JK = 1, IKU
+ ! b = (k-1) \ NREFINX + 1 where \ means euclidian division
+ ! as k,1 and NREFINX are integers, (k-1)/NREFINX is an integer division
+ IB = (JK - 1) / NREFINX + 1
+ ! a = k - (b-1)*NREFINX
+ IA = JK - (IB - 1) * NREFINX
+ !
+ DO JJ = 1, IJU
+ ! m = (j-1)*NREFINY + b
+ IM = (JJ - 1) * NREFINY + IB
+ !
+ DO JI = 1, IIU
+ ! l = (i-1)*NREFINX + a
+ IL = (JI - 1) * NREFINX + IA
+ ! PHI2D(l,m) = PHI3D(i,j,k)
+ XLSPHI2D(IL,IM) = PLSPHI(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+
+ !* 3. Compute laplacian on 2D grid
+
+ XLSDIFFUX2D(2:ILU-1,:) = (XLSPHI2D(3:ILU,:) - 2.*XLSPHI2D(2:ILU-1,:) + XLSPHI2D(1:ILU-2,:)) / XFIREMESHSIZE(1)
+ XLSDIFFUY2D(:,2:IMU-1) = (XLSPHI2D(:,3:IMU) - 2.*XLSPHI2D(:,2:IMU-1) + XLSPHI2D(:,1:IMU-2)) / XFIREMESHSIZE(2)
+
+ !* 4. Convert laplacian from 2d to 3d format
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+ DO JM = 1, IMU
+ ! j = ceil(m/NREFINY)
+ IJ = CEILING(REAL(JM) / REAL(NREFINY))
+ ! b = m - (j-1) * NREFINY
+ IB = JM - (IJ - 1) * NREFINY
+ !
+ DO JL = 1, ILU
+ ! i = ceil(l/NREFINX)
+ II = CEILING(REAL(JL) / REAL(NREFINX))
+ ! a = l - (i-1) * NREFINX
+ IA = JL - (II - 1) * NREFINX
+ ! k = (b-1) * NREFINX + a
+ IK = (IB - 1) * NREFINX + IA
+ ! GRAD3D(i,j,k) = GRAD2D(l,m)
+ PLSDIFFUX(II,IJ,IK) = XLSDIFFUX2D(JL,JM)
+ PLSDIFFUY(II,IJ,IK) = XLSDIFFUY2D(JL,JM)
+ END DO
+ END DO
+
+END SUBROUTINE FIRE_LSDIFFU
+
+
+SUBROUTINE FIRE_ROSDIFFU( PFIRERW )
+ !!**** *FIRE_ROSDIFFU* - Fire model computation of ROS diffusion
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute diffusion on x and y direcctions for rate of spread
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! Centered 2nd order scheme
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 24/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_PARAMETERS
+ USE MODD_CST
+ USE MODD_FIELD_n, ONLY : XFIRERW2D
+ !
+ USE MODD_FIRE
+ !USE MODI_FIRE_MODEL
+ !
+ USE MODE_MPPDB
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ !! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIRERW ! ROS
+ !
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: IIU, IJU ! atm mesh bounds
+ INTEGER :: ILU, IMU ! fire mesh bounds
+ INTEGER :: IKU ! fire 3rd dimension bounds
+ INTEGER :: IA,IB,II,IJ,IK,IL,IM ! Index for conversions
+ ! loop
+ INTEGER :: JI,JJ,JK ! index for atm mesh loop i,j,k
+ INTEGER :: JL,JM ! index for fire mesh loop l,m
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Allocate 2D array with fire grid bounds
+
+ ! get atm mesh bounds
+ IIU = SIZE(PFIRERW,1)
+ IJU = SIZE(PFIRERW,2)
+ IKU = SIZE(PFIRERW,3) ! NREFINX * NREFINY
+
+ ILU = SIZE(XFIRERW2D,1)
+ IMU = SIZE(XFIRERW2D,2)
+
+ !* 2. Convert LS function Phi from 3d to 2d format
+
+ ! get l and m to find PHI2D(l,m) = PHI3D(i,j,k)
+ DO JK = 1, IKU
+ ! b = (k-1) \ NREFINX + 1 where \ means euclidian division
+ ! as k,1 and NREFINX are integers, (k-1)/NREFINX is an integer division
+ IB = (JK - 1) / NREFINX + 1
+ ! a = k - (b-1)*NREFINX
+ IA = JK - (IB - 1) * NREFINX
+ !
+ DO JJ = 1, IJU
+ ! m = (j-1)*NREFINY + b
+ IM = (JJ - 1) * NREFINY + IB
+ !
+ DO JI = 1, IIU
+ ! l = (i-1)*NREFINX + a
+ IL = (JI - 1) * NREFINX + IA
+ ! PHI2D(l,m) = PHI3D(i,j,k)
+ XFIRERW2D(IL,IM) = PFIRERW(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+
+ !* 3. Compute laplacian on 2D grid
+
+ ! sub cycle 1
+ XFIRERW2D(2:ILU-1,2:IMU-1) = XFIRERW2D(2:ILU-1,2:IMU-1) + XROSDIFFUSION * (&
+ (XFIRERW2D(3:ILU,2:IMU-1) - 2.*XFIRERW2D(2:ILU-1,2:IMU-1) + XFIRERW2D(1:ILU-2,2:IMU-1)) &
+ / XFIREMESHSIZE(1) + &
+ (XFIRERW2D(2:ILU-1,3:IMU) - 2.*XFIRERW2D(2:ILU-1,2:IMU-1) + XFIRERW2D(2:ILU-1,1:IMU-2)) &
+ / XFIREMESHSIZE(2))
+ ! sub cycle 2
+ XFIRERW2D(3:ILU-2,3:IMU-2) = XFIRERW2D(3:ILU-2,3:IMU-2) + XROSDIFFUSION * (&
+ (XFIRERW2D(4:ILU-1,3:IMU-2) - 2.*XFIRERW2D(3:ILU-2,3:IMU-2) + XFIRERW2D(2:ILU-3,3:IMU-2)) &
+ / XFIREMESHSIZE(1) + &
+ (XFIRERW2D(3:ILU-2,4:IMU-1) - 2.*XFIRERW2D(3:ILU-2,3:IMU-2) + XFIRERW2D(3:ILU-2,2:IMU-3)) &
+ / XFIREMESHSIZE(2))
+ !
+
+ !* 4. Convert laplacian from 2d to 3d format
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+ DO JM = 1, IMU
+ ! j = ceil(m/NREFINY)
+ IJ = CEILING(REAL(JM) / REAL(NREFINY))
+ ! b = m - (j-1) * NREFINY
+ IB = JM - (IJ - 1) * NREFINY
+ !
+ DO JL = 1, ILU
+ ! i = ceil(l/NREFINX)
+ II = CEILING(REAL(JL) / REAL(NREFINX))
+ ! a = l - (i-1) * NREFINX
+ IA = JL - (II - 1) * NREFINX
+ ! k = (b-1) * NREFINX + a
+ IK = (IB - 1) * NREFINX + IA
+ ! GRAD3D(i,j,k) = GRAD2D(l,m)
+ PFIRERW(II,IJ,IK) = XFIRERW2D(JL,JM)
+ END DO
+ END DO
+
+END SUBROUTINE FIRE_ROSDIFFU
+
+
+SUBROUTINE FIRE_SUBGRIDSURFACE( PLSPHI2D, PSURFRATIO2D )
+ !!**** *FIRE_SUBGRIDSURFACE* - Fire model computation of subgrid burning area
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute subgrid burning area
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! EFFR: Explicit Fire Front reconstruction
+ !! WA: Weighted Averaged
+ !! See Costes et al. [2021] for more details
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Costes et al [2021]
+ !!
+ !! Technical reports
+ !! [a] 19S52, A. Costes [2019]
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ USE MODI_FIRE_MODEL, ONLY: FIRE_QUANDRANTSURFACE
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLSPHI2D ! Level Set function in 2D array
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PSURFRATIO2D ! Surface ratio in 2D array
+
+ !* 0.2 declarations of local variables
+ !
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHISW ! Phi value at South West point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHIS ! Phi value at South point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHISE ! Phi value at South East point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHIE ! Phi value at East point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHINE ! Phi value at North East point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHIN ! Phi value at North point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHINW ! Phi value at North West point
+ REAL, DIMENSION(SIZE(PLSPHI2D,1),SIZE(PLSPHI2D,2)) :: ZPHIW ! Phi value at West point
+
+ INTEGER :: ZCI ! Crossing identifier
+
+ INTEGER :: ILU, IMU
+ !----------------------------------------------------------------------------------------------
+ !
+ !* 1. Default values and sizes
+
+ PSURFRATIO2D(:,:) = 0.
+
+ ILU = SIZE(PLSPHI2D,1)
+ IMU = SIZE(PLSPHI2D,2)
+
+ ZPHISW(:,:) = 0.
+ ZPHIS(:,:) = 0.
+ ZPHISE(:,:) = 0.
+ ZPHIE(:,:) = 0.
+ ZPHINE(:,:) = 0.
+ ZPHIN(:,:) = 0.
+ ZPHINW(:,:) = 0.
+ ZPHIW(:,:) = 0.
+
+ !* 2. Interpolation of corners for south west quadrant
+
+ ! South west interpolation
+ ZPHISW(2:ILU-1,2:IMU-1) = 0.25 * (PLSPHI2D(1:ILU-2,1:IMU-2) + PLSPHI2D(2:ILU-1,1:IMU-2) + &
+ PLSPHI2D(1:ILU-2,2:IMU-1) + PLSPHI2D(2:ILU-1,2:IMU-1))
+ ! South interpolation
+ ZPHIS(2:ILU-1,2:IMU-1) = 0.5 * (PLSPHI2D(2:ILU-1,1:IMU-2) + PLSPHI2D(2:ILU-1,2:IMU-1))
+
+ ! West interpolation
+ ZPHIW(2:ILU-1,2:IMU-1) = 0.5 * (PLSPHI2D(1:ILU-2,2:IMU-1) + PLSPHI2D(2:ILU-1,2:IMU-1))
+
+ CALL FIRE_QUANDRANTSURFACE( ZPHISW, ZPHIS, PLSPHI2D, ZPHIW, PSURFRATIO2D )
+
+ !* 3. Interpolation of corners for south east quadrant
+
+ ! South east interpolation
+ ZPHISE(2:ILU-1,2:IMU-1) = 0.25 * (PLSPHI2D(2:ILU-1,1:IMU-2) + PLSPHI2D(3:ILU ,1:IMU-2) + &
+ PLSPHI2D(2:ILU-1,2:IMU-1) + PLSPHI2D(3:ILU ,2:IMU-1))
+
+ ! East interpolation
+ ZPHIE(2:ILU-1,2:IMU-1) = 0.5 * (PLSPHI2D(2:ILU-1,2:IMU-1) + PLSPHI2D(3:ILU ,2:IMU-1))
+
+ CALL FIRE_QUANDRANTSURFACE( ZPHIS, ZPHISE, ZPHIE, PLSPHI2D, PSURFRATIO2D )
+
+ !* 4. Interpolation of corners for North east quadrant
+
+ ! North east interpolation
+ ZPHINE(2:ILU-1,2:IMU-1) = 0.25 * (PLSPHI2D(2:ILU-1,2:IMU-1) + PLSPHI2D(3:ILU ,2:IMU-1) + &
+ PLSPHI2D(2:ILU-1,3:IMU ) + PLSPHI2D(3:ILU ,3:IMU ))
+
+ ! North interpolation
+ ZPHIN(2:ILU-1,2:IMU-1) = 0.5 * (PLSPHI2D(2:ILU-1,2:IMU-1) + PLSPHI2D(2:ILU-1,3:IMU ))
+
+ CALL FIRE_QUANDRANTSURFACE( PLSPHI2D, ZPHIE, ZPHINE, ZPHIN, PSURFRATIO2D )
+
+ !* 5. Interpolation of corners for North west quadrant
+
+ ! North west corner
+ ZPHINW(2:ILU-1,2:IMU-1) = 0.25 * (PLSPHI2D(1:ILU-2,2:IMU-1) + PLSPHI2D(2:ILU-1,2:IMU-1) + &
+ PLSPHI2D(1:ILU-2,3:IMU ) + PLSPHI2D(2:ILU-1,3:IMU ))
+
+ CALL FIRE_QUANDRANTSURFACE( ZPHIW, PLSPHI2D, ZPHIN, ZPHINW, PSURFRATIO2D )
+
+END SUBROUTINE FIRE_SUBGRIDSURFACE
+
+
+SUBROUTINE FIRE_QUANDRANTSURFACE( PPHI1, PPHI2, PPHI3, PPHI4, PSURFRATIO2D )
+ !!**** *FIRE_QUANDRANTSURFACE* - Fire model computation of subgrid burning area for quadrant
+ !!
+ !! PURPOSE
+ !! -------
+ !! Computation of subgrid burning area for quadrant with EFFR method
+ !! This method is also used in pyrolib and is tested for accuracy.
+ !! If you change this subroutine, please change the same part in pyrolib.
+ !!
+ !!** METHOD
+ !! ------
+ !! See Costes et al [2021]
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! Costes et al [2021]
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ USE MODI_FIRE_MODEL, ONLY: FIRE_SURF_68,FIRE_SURF_70,FIRE_SURF_22,FIRE_SURF_28
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI1 ! Phi at south west point
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI2 ! Phi at south east point
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI3 ! Phi at north east point
+ REAL,DIMENSION(:,:), INTENT(IN) :: PPHI4 ! Phi at north west point
+ REAL,DIMENSION(:,:), INTENT(INOUT) :: PSURFRATIO2D ! Subgrid burning surface for cell
+
+ !* 0.2 declarations of local variables
+ ! Intersections
+ INTEGER :: ZD1 ! Intersection quantity for south border
+ INTEGER :: ZD2 ! Intersection quantity for east border
+ INTEGER :: ZD3 ! Intersection quantity for north border
+ INTEGER :: ZD4 ! Intersection quantity for west border
+
+ REAL :: ZPHI1 ! Phi at south west point
+ REAL :: ZPHI2 ! Phi at south east point
+ REAL :: ZPHI3 ! Phi at north east point
+ REAL :: ZPHI4 ! Phi at north west point
+ REAL :: ZQUADSURF ! Subgrid burning surface for quadrant
+
+ !
+ INTEGER :: ZCI ! Crossing identifier
+
+ INTEGER :: ILU, IMU
+ INTEGER :: JL, JM
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Default values and sizes
+
+ ILU = SIZE(PPHI1,1)
+ IMU = SIZE(PPHI1,2)
+
+ !* 2. Check full or empty cells
+
+ ! loop on 2d ire grid
+ DO JM = 2, IMU-1
+ DO JL = 1,ILU-1
+
+ ! get corners values
+ ZPHI1 = PPHI1(JL,JM)
+ ZPHI2 = PPHI2(JL,JM)
+ ZPHI3 = PPHI3(JL,JM)
+ ZPHI4 = PPHI4(JL,JM)
+
+ ! Full quadrant in fire when phi1,2,3,4 >= .5
+ IF(ZPHI1 >= .5 .AND. ZPHI2 >= .5 .AND. ZPHI3 >= .5 .AND. ZPHI4 >= .5 ) THEN
+ ZQUADSURF = 1.
+ PSURFRATIO2D(JL,JM) = PSURFRATIO2D(JL,JM) + .25 * ZQUADSURF
+ CYCLE
+ END IF
+
+ ! No fire in quadrant when phi1,2,3,4 < 5
+ IF(ZPHI1 < .5 .AND. ZPHI2 < .5 .AND. ZPHI3 < .5 .AND. ZPHI4 < .5 ) THEN
+ ZQUADSURF = 0.
+ PSURFRATIO2D(JL,JM) = PSURFRATIO2D(JL,JM) + .25 * ZQUADSURF
+ CYCLE
+ END IF
+
+ !* 3. Compute crossing values
+
+ ZD1 = NINT( SIGN(.5,ZPHI1 - .5) - SIGN(.5,ZPHI2 - .5))
+ ZD2 = NINT( SIGN(.5,ZPHI2 - .5) - SIGN(.5,ZPHI3 - .5))
+ ZD3 = NINT( SIGN(.5,ZPHI4 - .5) - SIGN(.5,ZPHI3 - .5))
+ ZD4 = NINT( SIGN(.5,ZPHI1 - .5) - SIGN(.5,ZPHI4 - .5))
+
+ !* 4. Compute trinary identifier
+
+ ! CI = 3^0 * (1+d1) + 3^1 * (1+d2) + 3^2 * (1+d3) + 3^3 * (1+d4)
+ ZCI = 1 + ZD1 + 3 * (1. + ZD2) +&
+ 9 * (1. + ZD3) + 27 * (1. + ZD4)
+
+ !* 5. Compute surface for each intersection case
+
+ SELECT CASE(ZCI)
+ CASE(68)
+ ! South west triangle burning
+ ZQUADSURF = FIRE_SURF_68(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(12)
+ ! Complementary case #68
+ ZQUADSURF = 1. - FIRE_SURF_68(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(70)
+ ! Southern trapeze burning
+ ZQUADSURF = FIRE_SURF_70(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(10)
+ ! Complementary case #70
+ ZQUADSURF = 1. - FIRE_SURF_70(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(22)
+ ! North west triangle burning
+ ZQUADSURF = FIRE_SURF_22(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(58)
+ ! Complementary case #22
+ ZQUADSURF = 1. - FIRE_SURF_22(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(42)
+ ! North west triangle burning
+ ! 22 case eqn with Phi2 / Phi4 permutation
+ ZQUADSURF = FIRE_SURF_22(ZPHI1,ZPHI4,ZPHI3,ZPHI2)
+
+ CASE(38)
+ ! Complementary case #42
+ ZQUADSURF = 1. - FIRE_SURF_22(ZPHI1,ZPHI4,ZPHI3,ZPHI2)
+
+ CASE(50)
+ ! Western trapeze burning
+ ! Eqn 70 with 2 - 4 permutation
+ ZQUADSURF = FIRE_SURF_70(ZPHI1,ZPHI4,ZPHI3,ZPHI2)
+
+ CASE(30)
+ ! Complementary case #50
+ ZQUADSURF = 1. - FIRE_SURF_70(ZPHI1,ZPHI4,ZPHI3,ZPHI2)
+
+ CASE(28)
+ ! North east triangle burning
+ ZQUADSURF = FIRE_SURF_28(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(52)
+ ! Complementary case #46
+ ZQUADSURF = 1. - FIRE_SURF_28(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE(24)
+ ! North west + South east triangles burning
+ ! #22 + #42
+ ZQUADSURF = FIRE_SURF_22(ZPHI1,ZPHI2,ZPHI3,ZPHI4) + FIRE_SURF_22(ZPHI1,ZPHI4,ZPHI3,ZPHI2)
+
+ CASE(56)
+ ! South west + North east triangles burning
+ ! #68 + #46
+ ZQUADSURF = FIRE_SURF_68(ZPHI1,ZPHI2,ZPHI3,ZPHI4) + FIRE_SURF_28(ZPHI1,ZPHI2,ZPHI3,ZPHI4)
+
+ CASE DEFAULT
+ WRITE(*,*) 'CASE DEFAULT for ', JL, JM
+ ZQUADSURF = 0.
+ END SELECT
+
+ !* 6. Add quadrant subgrid area to cell subgrid area
+
+ PSURFRATIO2D(JL,JM) = PSURFRATIO2D(JL,JM) + .25 * ZQUADSURF
+
+ END DO
+ END DO
+
+END SUBROUTINE FIRE_QUANDRANTSURFACE
+
+
+FUNCTION FIRE_SURF_68( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+ !!**** *FIRE_SURF_68* Compute surface ratio for cases :
+ !!
+ !! - 68 : SW triangle with Phi1, Phi2 and Phi4
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/12/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+
+ !* 1. Compute surface value
+
+ PSURF = (.5 - PPHI1)**2 / (2. * (PPHI2 - PPHI1) * (PPHI4 - PPHI1))
+
+END FUNCTION FIRE_SURF_68
+
+
+FUNCTION FIRE_SURF_70( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+ !!**** *FIRE_SURF_70* Compute surface ratio for cases :
+ !!
+ !! - 70 : S trapeze
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/12/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute surface value
+
+ PSURF = .5 * ((.5 -PPHI1) / (PPHI4 - PPHI1) + (.5 - PPHI2) / (PPHI3 - PPHI2))
+
+END FUNCTION FIRE_SURF_70
+
+
+FUNCTION FIRE_SURF_22( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+ !!**** *FIRE_SURF_22* Compute surface ratio for cases :
+ !!
+ !! - 22 : NW triangle
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/12/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ USE MODE_MPPDB
+
+ IMPLICIT NONE
+
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute surface value
+
+ PSURF = (PPHI4 - .5)**2 / (-2. * (PPHI4 - PPHI1) * (PPHI3 - PPHI4))
+
+END FUNCTION FIRE_SURF_22
+
+
+FUNCTION FIRE_SURF_28( PPHI1, PPHI2, PPHI3, PPHI4 ) RESULT( PSURF )
+ !!**** *FIRE_SURF_28* Compute surface ratio for cases :
+ !!
+ !! - 28 : NE triangle
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/12/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, INTENT(IN) :: PPHI1 ! Phi1
+ REAL, INTENT(IN) :: PPHI2 ! Phi2
+ REAL, INTENT(IN) :: PPHI3 ! Phi2
+ REAL, INTENT(IN) :: PPHI4 ! Phi4
+
+ REAL :: PSURF ! Surface ratio
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute surface value
+
+ PSURF = (PPHI3 - .5)**2 / (2. * (PPHI3 - PPHI2) * (PPHI3 - PPHI4))
+
+END FUNCTION FIRE_SURF_28
+
+
+SUBROUTINE FIRE_LS_RECONSTRUCTION_FROM_BMAP( PLSPHI, PBMAP, PATMDT )
+ !!**** *FIRE_LS_RECONSTRUCTION_FROM_BMAP* - Fire model level set reconstruction from burning map
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute level set function from bmap
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !! A. Costes PhD [2021], Chapter 2, Section 3.3.a
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 29/10/19
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !
+ USE MODD_FIRE
+ USE MODD_TIME_n, ONLY : TDTCUR
+ !USE MODI_FIRE_MODEL
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Level Set function
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBMAP ! Burning map
+ REAL, INTENT(IN) :: PATMDT ! Atm time step
+
+ !* 0.2 declarations of local variables
+
+ REAL :: ZLAMBDA ! Sigmoide parameter
+ REAL :: ZFITPARAM(4) ! Fitted parameters for lambda(dxf)
+ REAL :: ZFMMESHSIZE ! Mean of fire mesh size
+
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Lambda model parameters
+
+ ! lambda = a * exp(-b * (dxf - c)) + d
+ ZFITPARAM(1) = 2.13574296 ! a
+ ZFITPARAM(2) = 0.21070849 ! b
+ ZFITPARAM(3) = -8.61319574 ! c
+ ZFITPARAM(4) = 0.06448332 ! d
+
+ ZFMMESHSIZE = .5 * (XFIREMESHSIZE(1) + XFIREMESHSIZE(2))
+
+ !* 2. Compute lambda value fron exponential fitting for fire mesh size
+
+ ZLAMBDA = ZFITPARAM(1) * EXP(-1. * ZFITPARAM(2) * (ZFMMESHSIZE - ZFITPARAM(3))) + ZFITPARAM(4)
+
+ !* 3. Compute sigmoide for bmap cells at t+dt
+
+ WHERE(PBMAP >= 0)
+ PLSPHI = 1. / (1. + EXP(-1. * ZLAMBDA * (TDTCUR%XTIME + PATMDT - PBMAP)))
+ END WHERE
+
+END SUBROUTINE FIRE_LS_RECONSTRUCTION_FROM_BMAP
+
+
+SUBROUTINE FIRE_GRAD_OROGRAPHY( PZS, PFMGRADOROX, PFMGRADOROY )
+ !!**** *FIRE_GRAD_OROGRAPHY* - Fire model computation of orography gradient
+ !!
+ !! PURPOSE
+ !! -------
+ !! Compute orography gradient
+ !!
+ !!** METHOD
+ !! ------
+ !!
+ !! Compute orography gradient on atm mesh and then interpolate on fire grid (like the interpolation of horizontal wind)
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 14/10/21
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !
+ USE MODD_FIRE, ONLY: XFIREMESHSIZE, NREFINX, NREFINY
+ !
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! MNH orography (atm resolution) [m]
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMGRADOROX ! Orographic gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMGRADOROY ! Orographic gradient on y direction (dz/dy) [m/m]
+
+ !* 0.2 Declarations of local variables
+ !! -------------------------------
+ REAL, DIMENSION(SIZE(PZS,1),SIZE(PZS,2)) :: ZATMGRADOROX ! MNH gradient on x direction (dz/dx) [m/m]
+ REAL, DIMENSION(SIZE(PZS,1),SIZE(PZS,2)) :: ZATMGRADOROY ! MNH gradient on y direction (dz/dy) [m/m]
+ REAL, DIMENSION(SIZE(PZS,1)+1,SIZE(PZS,2)+1) :: ZATMCORNERX ! MNH gradient on x direction interpolated on atm. corners (dz/dx) [m/m]
+ REAL, DIMENSION(SIZE(PZS,1)+1,SIZE(PZS,2)+1) :: ZATMCORNERY ! MNH gradient on y direction interpolated on atm. corners (dz/dy) [m/m]
+
+ ! size of meshes
+ INTEGER :: IIU, IJU ! atm mesh bounds
+ INTEGER :: IKU ! fire 3rd dimension bounds
+ REAL :: ZDX, ZDY ! atm delta x and delta y
+ INTEGER :: IM, IL ! fire mesh absolute index
+
+ ! loops
+ INTEGER :: JI,JJ ! atm grid index
+ INTEGER :: JK,JL,JM ! fire grid index
+
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !!
+ !* 1. Get bounds and domain settings
+ !! ==============================
+
+ ! domain max indexes
+ IIU = SIZE(PFMGRADOROX,1)
+ IJU = SIZE(PFMGRADOROX,2)
+ IKU = SIZE(PFMGRADOROX,3) ! NREFINX * NREFINY
+
+ ! retrieve atm mesh size (dx = dxf * NREFINX)
+ ZDX = XFIREMESHSIZE(1) * REAL(NREFINX)
+ ZDY = XFIREMESHSIZE(2) * REAL(NREFINY)
+
+ !!
+ !* 2. Compute orographic gradient on atm mesh
+ !! =======================================
+
+ !* 2.1 Main loop
+ !! ---------
+ ! orographic gradient noted h_{i,j}^{x,a} in comments, z_{i,j} is ZS
+ ! 2nd order 2d FD scheme for main loop
+ ! h_{i,j}^{x,a} = (z_{i+1,j-1} - z_{i-1,j-1} + 2*(z_{i+1,j}-z_{i-1,j}) + z_{i+1,j+1}-z_{i-1,j+1}) / (8 * dx)
+ ! h_{i,j}^{y,a} = (z_{i-1,j+1} - z_{i-1,j-1} + 2*(z_{i,j+1}-z_{i,j-1}) + z_{i+1,j+1}-z_{i+1,j-1}) / (8 * dx)
+ DO JJ = 2, IJU-1
+ DO JI = 2, IIU-1
+ ZATMGRADOROX(JI,JJ) = (PZS(JI+1,JJ-1)-PZS(JI-1,JJ-1) + 2.*(PZS(JI+1,JJ)-PZS(JI-1,JJ)) &
+ + PZS(JI+1,JJ+1)-PZS(JI-1,JJ+1)) / (8. * ZDX)
+ ZATMGRADOROY(JI,JJ) = (PZS(JI-1,JJ+1)-PZS(JI-1,JJ-1) + 2.*(PZS(JI,JJ+1)-PZS(JI,JJ-1)) &
+ + PZS(JI+1,JJ+1)-PZS(JI+1,JJ-1)) / (8. * ZDY)
+ END DO
+ END DO
+
+ !* 2.1 West boundary
+ !! -------------
+ JI = 1
+ DO JJ = 2, IJU-1
+ ! uncentered scheme
+ ZATMGRADOROX(JI,JJ) = (PZS(JI+1,JJ-1)-PZS(JI,JJ-1) + 2.*(PZS(JI+1,JJ)-PZS(JI,JJ)) + PZS(JI+1,JJ+1)-PZS(JI,JJ+1)) / (4. * ZDX)
+ ! do not use JI-1 points
+ ZATMGRADOROY(JI,JJ) = (2.*(PZS(JI,JJ+1)-PZS(JI,JJ-1)) + PZS(JI+1,JJ+1)-PZS(JI+1,JJ-1)) / (6. * ZDY)
+ END DO
+
+ !* 2.2 East boundary
+ !! -------------
+ JI = IIU
+ DO JJ = 2, IJU-1
+ ! uncentered scheme
+ ZATMGRADOROX(JI,JJ) = (PZS(JI,JJ-1)-PZS(JI-1,JJ-1) + 2.*(PZS(JI,JJ)-PZS(JI-1,JJ)) + PZS(JI,JJ+1)-PZS(JI-1,JJ+1)) / (4. * ZDX)
+ ! do not use JI+1 points
+ ZATMGRADOROY(JI,JJ) = (PZS(JI-1,JJ+1)-PZS(JI-1,JJ-1) + 2.*(PZS(JI,JJ+1)-PZS(JI,JJ-1))) / (6. * ZDY)
+ END DO
+
+ !* 2.3 South boundary
+ !! --------------
+ JJ = 1
+ DO JI = 2, IIU-1
+ ! do not use JJ-1 points
+ ZATMGRADOROX(JI,JJ) = (2.*(PZS(JI+1,JJ)-PZS(JI-1,JJ)) + PZS(JI+1,JJ+1)-PZS(JI-1,JJ+1)) / (6. * ZDX)
+ ! uncentered scheme
+ ZATMGRADOROY(JI,JJ) = (PZS(JI-1,JJ+1)-PZS(JI-1,JJ) + 2.*(PZS(JI,JJ+1)-PZS(JI,JJ)) + PZS(JI+1,JJ+1)-PZS(JI+1,JJ)) / (4. * ZDY)
+ END DO
+
+ !* 2.4 North boundary
+ !! --------------
+ JJ = IJU
+ DO JI = 2, IIU-1
+ ! do not use JJ+1 points
+ ZATMGRADOROX(JI,JJ) = (PZS(JI+1,JJ-1)-PZS(JI-1,JJ-1) + 2.*(PZS(JI+1,JJ)-PZS(JI-1,JJ))) / (6. * ZDX)
+ ! uncentered scheme
+ ZATMGRADOROY(JI,JJ) = (PZS(JI-1,JJ)-PZS(JI-1,JJ-1) + 2.*(PZS(JI,JJ)-PZS(JI,JJ-1)) + PZS(JI+1,JJ)-PZS(JI+1,JJ-1)) / (4. * ZDY)
+ END DO
+
+ !* 2.5 Corners
+ !! -------
+ ! SW
+ JI = 1
+ JJ = 1
+ ZATMGRADOROX(JI,JJ) = (2.*(PZS(JI+1,JJ)-PZS(JI,JJ)) + PZS(JI+1,JJ+1)-PZS(JI,JJ+1)) / (3. * ZDX)
+ ZATMGRADOROY(JI,JJ) = (2.*(PZS(JI,JJ+1)-PZS(JI,JJ)) + PZS(JI+1,JJ+1)-PZS(JI+1,JJ)) / (3. * ZDY)
+ ! SE
+ JI = IIU
+ JJ = 1
+ ZATMGRADOROX(JI,JJ) = (2.*(PZS(JI,JJ)-PZS(JI-1,JJ)) + PZS(JI,JJ+1)-PZS(JI-1,JJ+1)) / (3. * ZDX)
+ ZATMGRADOROY(JI,JJ) = (PZS(JI-1,JJ+1)-PZS(JI-1,JJ) + 2.*(PZS(JI,JJ+1)-PZS(JI,JJ))) / (3. * ZDY)
+ ! NW
+ JI = 1
+ JJ = IJU
+ ZATMGRADOROX(JI,JJ) = (PZS(JI+1,JJ-1)-PZS(JI,JJ-1) + 2.*(PZS(JI+1,JJ)-PZS(JI,JJ))) / (3. * ZDX)
+ ZATMGRADOROY(JI,JJ) = (2.*(PZS(JI,JJ)-PZS(JI,JJ-1)) + PZS(JI+1,JJ)-PZS(JI+1,JJ-1)) / (3. * ZDY)
+ ! NE
+ JI = IIU
+ JJ = IJU
+ ZATMGRADOROX(JI,JJ) = (PZS(JI,JJ-1)-PZS(JI-1,JJ-1) + 2.*(PZS(JI,JJ)-PZS(JI-1,JJ))) / (3. * ZDX)
+ ZATMGRADOROY(JI,JJ) = (PZS(JI-1,JJ)-PZS(JI-1,JJ-1) + 2.*(PZS(JI,JJ)-PZS(JI,JJ-1))) / (3. * ZDY)
+
+ !!
+ !* 3. Interpolate on atmospheric grid corners
+ !! =======================================
+
+ !* 3.1 Main loop
+ !! ---------
+
+ DO JJ = 2, IJU
+ DO JI = 2, IIU
+ ZATMCORNERX(JI,JJ) = .25 * (ZATMGRADOROX(JI-1,JJ) + ZATMGRADOROX(JI,JJ) + ZATMGRADOROX(JI-1,JJ-1) + ZATMGRADOROX(JI,JJ-1))
+ ZATMCORNERY(JI,JJ) = .25 * (ZATMGRADOROY(JI-1,JJ) + ZATMGRADOROY(JI,JJ) + ZATMGRADOROY(JI-1,JJ-1) + ZATMGRADOROY(JI,JJ-1))
+ END DO
+ END DO
+
+ !* 3.1 West boundary
+ !! -------------
+ JI = 1
+ DO JJ = 2, IJU
+ ZATMCORNERX(JI,JJ) = .25 * (3. * ZATMGRADOROX(JI,JJ) - ZATMGRADOROX(JI+1,JJ) + &
+ 3. * ZATMGRADOROX(JI,JJ-1) - ZATMGRADOROX(JI+1,JJ-1))
+ ZATMCORNERY(JI,JJ) = .25 * (3. * ZATMGRADOROY(JI,JJ) - ZATMGRADOROY(JI+1,JJ) + &
+ 3. * ZATMGRADOROY(JI,JJ-1) - ZATMGRADOROY(JI+1,JJ-1))
+ END DO
+
+ !* 3.2 East boundary
+ !! -------------
+ JI = IIU+1
+ DO JJ = 2, IJU
+ ZATMCORNERX(JI,JJ) = .25 * (3. * ZATMGRADOROX(JI-1,JJ) - ZATMGRADOROX(JI-2,JJ) + &
+ 3. * ZATMGRADOROX(JI-1,JJ-1) - ZATMGRADOROX(JI-2,JJ-1))
+ ZATMCORNERY(JI,JJ) = .25 * (3. * ZATMGRADOROY(JI-1,JJ) - ZATMGRADOROY(JI-2,JJ) + &
+ 3. * ZATMGRADOROY(JI-1,JJ-1) - ZATMGRADOROY(JI-2,JJ-1))
+ END DO
+
+ !* 3.3 South boundary
+ !! --------------
+ JJ = 1
+ DO JI = 2, IIU
+ ZATMCORNERX(JI,JJ) = .25 * (3. * ZATMGRADOROX(JI,JJ) - ZATMGRADOROX(JI,JJ+1) + &
+ 3. * ZATMGRADOROX(JI-1,JJ) - ZATMGRADOROX(JI-1,JJ+1))
+ ZATMCORNERY(JI,JJ) = .25 * (3. * ZATMGRADOROY(JI,JJ) - ZATMGRADOROY(JI,JJ+1) + &
+ 3. * ZATMGRADOROY(JI-1,JJ) - ZATMGRADOROY(JI-1,JJ+1))
+ END DO
+
+ !* 3.4 North boundary
+ !! --------------
+ JJ = IJU+1
+ DO JI = 2, IIU
+ ZATMCORNERX(JI,JJ) = .25 * (3. * ZATMGRADOROX(JI,JJ-1) - ZATMGRADOROX(JI,JJ-2) + &
+ 3. * ZATMGRADOROX(JI-1,JJ-1) - ZATMGRADOROX(JI-1,JJ-2))
+ ZATMCORNERY(JI,JJ) = .25 * (3. * ZATMGRADOROY(JI,JJ-1) - ZATMGRADOROY(JI,JJ-2) + &
+ 3. * ZATMGRADOROY(JI-1,JJ-1) - ZATMGRADOROY(JI-1,JJ-2))
+ END DO
+
+ !* 3.5 Corners
+ !! -------
+ ! SW
+ JI = 1
+ JJ = 1
+ ZATMCORNERX(JI,JJ) = .5 * (2. * ZATMCORNERX(JI+1,JJ) - ZATMCORNERX(JI+2,JJ) + 2. * ZATMCORNERX(JI,JJ+1) - ZATMCORNERX(JI,JJ+2))
+ ZATMCORNERY(JI,JJ) = .5 * (2. * ZATMCORNERY(JI+1,JJ) - ZATMCORNERY(JI+2,JJ) + 2. * ZATMCORNERY(JI,JJ+1) - ZATMCORNERY(JI,JJ+2))
+ ! SE
+ JI = IIU+1
+ JJ = 1
+ ZATMCORNERX(JI,JJ) = .5 * (2. * ZATMCORNERX(JI-1,JJ) - ZATMCORNERX(JI-2,JJ) + 2. * ZATMCORNERX(JI,JJ+1) - ZATMCORNERX(JI,JJ+2))
+ ZATMCORNERY(JI,JJ) = .5 * (2. * ZATMCORNERY(JI-1,JJ) - ZATMCORNERY(JI-2,JJ) + 2. * ZATMCORNERY(JI,JJ+1) - ZATMCORNERY(JI,JJ+2))
+ ! NW
+ JI = 1
+ JJ = IJU+1
+ ZATMCORNERX(JI,JJ) = .5 * (2. * ZATMCORNERX(JI+1,JJ) - ZATMCORNERX(JI+2,JJ) + 2. * ZATMCORNERX(JI,JJ-1) - ZATMCORNERX(JI,JJ-2))
+ ZATMCORNERY(JI,JJ) = .5 * (2. * ZATMCORNERY(JI+1,JJ) - ZATMCORNERY(JI+2,JJ) + 2. * ZATMCORNERY(JI,JJ-1) - ZATMCORNERY(JI,JJ-2))
+ ! NE
+ JI = IIU+1
+ JJ = IJU+1
+ ZATMCORNERX(JI,JJ) = .5 * (2. * ZATMCORNERX(JI-1,JJ) - ZATMCORNERX(JI-2,JJ) + 2. * ZATMCORNERX(JI,JJ-1) - ZATMCORNERX(JI,JJ-2))
+ ZATMCORNERY(JI,JJ) = .5 * (2. * ZATMCORNERY(JI-1,JJ) - ZATMCORNERY(JI-2,JJ) + 2. * ZATMCORNERY(JI,JJ-1) - ZATMCORNERY(JI,JJ-2))
+
+ !* 3. Interpolate on fire grid
+ !! ========================
+
+ ! same method as for wind interpolation
+
+ DO JK = 1, IKU
+ ! compute index position of grid cell
+ IM = (JK - 1) / NREFINX + 1
+ IL = JK - (IM - 1) * NREFINX
+ ! interpolate for each atm cell
+ DO JJ = 1, IJU
+ DO JI = 1, IIU
+ PFMGRADOROX(JI,JJ,JK) = (IM * (IL * ZATMCORNERX(JI+1,JJ+1) + (NREFINX + 1 - IL) * ZATMCORNERX(JI,JJ+1)) + &
+ (NREFINY + 1 - IM) * (IL * ZATMCORNERX(JI+1,JJ) + (NREFINX + 1 - IL) * ZATMCORNERX(JI,JJ))) / &
+ REAL((NREFINX + 1) * (NREFINY + 1))
+ PFMGRADOROY(JI,JJ,JK) = (IM * (IL * ZATMCORNERY(JI+1,JJ+1) + (NREFINX + 1 - IL) * ZATMCORNERY(JI,JJ+1)) + &
+ (NREFINY + 1 - IM) * (IL * ZATMCORNERY(JI+1,JJ) + (NREFINX + 1 - IL) * ZATMCORNERY(JI,JJ))) / &
+ REAL((NREFINX + 1) * (NREFINY + 1))
+ END DO
+ END DO
+ END DO
+
+END SUBROUTINE FIRE_GRAD_OROGRAPHY
+
+!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEPRECATED CONTENT
+!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! -----------------------------------------------------------------------------
+!! Following function are defined to get 3d index (i,j,k) from 2d (l,m)
+!! but are not used in Blaze for now
+!! -----------------------------------------------------------------------------
+FUNCTION FGET_I(PLINDEX,PMINDEX) RESULT(POUTINDEX)
+ !!**** *FGET_I* Compute i atm index from l,m fire index :
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/07/21
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE, ONLY : NREFINX,NREFINY
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ INTEGER, INTENT(IN) :: PLINDEX ! l fire index
+ INTEGER, INTENT(IN) :: PMINDEX ! m fire index
+
+ INTEGER :: POUTINDEX ! i atm index
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: IA, IB, II, IJ, IK
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute atm index
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+
+ ! i = ceil(l/NREFINX)
+ POUTINDEX = CEILING(REAL(PLINDEX) / REAL(NREFINX))
+
+END FUNCTION FGET_I
+
+
+FUNCTION FGET_J(PLINDEX,PMINDEX) RESULT(POUTINDEX)
+ !!**** *FGET_J* Compute j atm index from l,m fire index :
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/07/21
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE, ONLY : NREFINX,NREFINY
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ INTEGER, INTENT(IN) :: PLINDEX ! l fire index
+ INTEGER, INTENT(IN) :: PMINDEX ! m fire index
+
+ INTEGER :: POUTINDEX ! i atm index
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: IA, IB, II, IJ, IK
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute atm index
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+ ! j = ceil(m/NREFINY)
+ POUTINDEX = CEILING(REAL(PMINDEX) / REAL(NREFINY))
+
+END FUNCTION FGET_J
+
+
+FUNCTION FGET_K(PLINDEX,PMINDEX) RESULT(POUTINDEX)
+ !!**** *FGET_J* Compute j atm index from l,m fire index :
+ !!
+ !!
+ !! AUTHOR
+ !! ------
+ !! A. Costes (Météo-France-Cerfacs)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 20/07/21
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !! ============
+ !
+ USE MODD_FIRE, ONLY : NREFINX,NREFINY
+ USE MODE_MPPDB
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !! -------------------------
+
+ INTEGER, INTENT(IN) :: PLINDEX ! l fire index
+ INTEGER, INTENT(IN) :: PMINDEX ! m fire index
+
+ INTEGER :: POUTINDEX ! i atm index
+
+ !* 0.2 declarations of local variables
+
+ INTEGER :: IA, IB, II, IJ
+ !----------------------------------------------------------------------------------------------
+ !
+
+ !* 1. Compute atm index
+
+ ! get i,j and k to find GRAD3D(i,j,k) = GRAD2D(l,m)
+ IJ = CEILING(REAL(PMINDEX) / REAL(NREFINY))
+ ! b = m - (j-1) * NREFINY
+ IB = PMINDEX - (IJ - 1) * NREFINY
+ ! i = ceil(l/NREFINX)
+ II = CEILING(REAL(PLINDEX) / REAL(NREFINX))
+ ! a = l - (i-1) * NREFINX
+ IA = PLINDEX - (II - 1) * NREFINX
+ ! k = (b-1) * NREFINX + a
+ POUTINDEX = (IB - 1) * NREFINX + IA
+
+END FUNCTION FGET_K
+!! -----------------------------------------------------------------------------
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index c438ead7fe900e3a1748ab41a9ca0656ccee065b..4bb197e20ac0ce95c78aecada0a5a31ec80a5291 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -10,11 +10,13 @@ MODULE MODI_GROUND_PARAM_n
INTERFACE
!
SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
!
!* surface fluxes
! --------------
!
+USE MODD_IO, ONLY: TFILEDATA
+!
REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
@@ -31,6 +33,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spect
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-)
REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K)
!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
END SUBROUTINE GROUND_PARAM_n
!
END INTERFACE
@@ -39,7 +43,7 @@ END MODULE MODI_GROUND_PARAM_n
!
! ######################################################################
SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
! #######################################################################
!
!
@@ -112,6 +116,7 @@ END MODULE MODI_GROUND_PARAM_n
!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 09/02/2022: bugfix: add missing XCURRENT_LEI computation
+! A. Costes 12/2021: Blaze Fire model
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -133,12 +138,16 @@ USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
USE MODD_DYN_n, ONLY : XTSTEP
USE MODD_CH_MNHC_n, ONLY : LUSECHEM
USE MODD_CH_M9_n, ONLY : CNAMES
-USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS
+USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS,&
+XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE,&
+XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG,&
+XFMFLUXHDH, XFMFLUXHDW, XRTHS, XRRS, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
+XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
USE MODD_DIM_n, ONLY : NKMAX
USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
XCOSSLOPE, XSINSLOPE, XZS
-USE MODD_REF_n, ONLY : XRHODREF,XRHODJ
+USE MODD_REF_n, ONLY : XRHODREF,XRHODJ,XEXNREF
USE MODD_CONF_n, ONLY : NRR
USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD
USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
@@ -186,6 +195,13 @@ USE MODD_TIME
!
USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
!
+USE MODD_FIRE
+USE MODD_FIELD
+USE MODI_FIRE_MODEL
+USE MODD_CONF, ONLY : NVERB, NHALO
+USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODD_IO, ONLY: TFILEDATA
+!
IMPLICIT NONE
!
!
@@ -211,6 +227,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spect
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-)
REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K)
!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
!
!-------------------------------------------------------------------------------
!
@@ -356,6 +374,16 @@ CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar var
REAL :: ZTIMEC
INTEGER :: ILUOUT ! logical unit
!
+! Fire model
+REAL, DIMENSION(2) :: ZFIRETIME1, ZFIRETIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZGRADTIME1, ZGRADTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZPROPAGTIME1, ZPROPAGTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZFLUXTIME1, ZFLUXTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZROSWINDTIME1, ZROSWINDTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIREFUELMAP ! Fuel map
+CHARACTER(LEN=7) :: YFUELMAPFILE ! Fuel Map file name
+TYPE(LIST_ll), POINTER :: TZFIELDFIRE_ll ! list of fields to exchange
+
!-------------------------------------------------------------------------------
!
!
@@ -666,6 +694,158 @@ WHERE (ZSFU(:,:)/=XUNDEF .AND. ZWIND(:,:)>0.)
PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
END WHERE
!
+
+!* 2.1 Blaze Fire Model
+! ----------------
+!
+IF (LBLAZE) THEN
+ ! get start time
+ CALL SECOND_MNH2( ZFIRETIME1 )
+
+ !* 2.1.1 Local variables allocation
+ ! --------------------------
+ !
+
+ ! Parallel fuel
+ NULLIFY(TZFIELDFIRE_ll)
+ IF (KTCOUNT <= 1) THEN
+ ! fuelmap
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ !
+ ALLOCATE( ZFIREFUELMAP(SIZE(XLSPHI,1), SIZE(XLSPHI,2), SIZE(XLSPHI,3), 22) );
+ ! Parallel fuel
+ CALL ADD4DFIELD_ll( TZFIELDFIRE_ll, ZFIREFUELMAP(:,:,:,1::22), 'MODEL_n::ZFIREFUELMAP' )
+ ! Default value
+ ZFIREFUELMAP(:,:,:,:) = 0.
+ END SELECT
+
+ !* 2.1.2 Read fuel map file
+ ! ------------------
+ !
+ ! Fuel map file name
+ YFUELMAPFILE = 'FuelMap'
+ !
+ CALL FIRE_READFUEL( TPFILE, ZFIREFUELMAP, XFMIGNITION, XFMWALKIG )
+
+ !* 2.1.3 Ignition LS function with ignition map
+ ! --------------------------------------
+ !
+ SELECT CASE (CFIRE_CPL_MODE)
+ CASE('2WAYCPL', 'ATM2FIR')
+ ! force ignition
+ WHERE (XFMIGNITION <= TDTCUR%XTIME ) XLSPHI = 1.
+ ! walking ignition
+ CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( XLSPHI, XFMWALKIG, 0.)
+ !
+ !* 2.1.4 Update BMAP
+ ! -----------
+ !
+ WHERE (XLSPHI >= .5 .AND. XBMAP < 0) XBMAP = TDTCUR%XTIME
+ !
+ CASE('FIR2ATM')
+ CALL FIRE_READBMAP(TPFILE,XBMAP)
+
+ END SELECT
+ !
+ !* 2.1.5 Compute R0, A, Wf0, R00
+ ! -----------------------
+ !
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ CALL FIRE_NOWINDROS( ZFIREFUELMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMFUELTYPE, XFIRETAU, XFLUXPARAMH, &
+ XFLUXPARAMW, XFMASE, XFMAWC )
+ END SELECT
+ !
+ !* 2.1.6 Compute orographic gradient
+ ! ---------------------------
+ CALL FIRE_GRAD_OROGRAPHY( XZS, XFMGRADOROX, XFMGRADOROY )
+ !
+ !* 2.1.7 Test halo size
+ ! --------------
+ IF (NHALO < 2 .AND. NFIRE_WENO_ORDER == 3) THEN
+ PRINT *, 'ERROR : WENO3 fire gradient calculation needs NHALO >= 2'
+ CALL ABORT
+ STOP ' Error in ground_paramn.f90. Step 2.1.7'
+ ELSEIF (NHALO < 3 .AND. NFIRE_WENO_ORDER == 5) THEN
+ PRINT *, 'ERROR : WENO5 fire gradient calculation needs NHALO >= 3'
+ CALL ABORT
+ STOP ' Error in ground_paramn.f90. Step 2.1.7'
+ END IF
+ !
+ END IF
+ !
+ !* 2.1.6 Compute grad of level set function phi
+ ! --------------------------------------
+ !
+ SELECT CASE (CFIRE_CPL_MODE)
+ CASE('2WAYCPL', 'ATM2FIR')
+ ! get time 1
+ CALL SECOND_MNH2( ZGRADTIME1 )
+ CALL FIRE_GRADPHI( XLSPHI, XGRADLSPHIX, XGRADLSPHIY )
+
+ ! get time 2
+ CALL SECOND_MNH2( ZGRADTIME2 )
+ XGRADPERF = XGRADPERF + ZGRADTIME2 - ZGRADTIME1
+ !
+ !* 2.1.7 Get horizontal wind speed projected on LS gradient direction
+ ! ------------------------------------------------------------
+ !
+ CALL FIRE_GETWIND( XUT, XVT, XWT, XGRADLSPHIX, XGRADLSPHIY, XFIREWIND, KTCOUNT, XTSTEP, XFMGRADOROX, XFMGRADOROY )
+ !
+ !* 2.1.8 Compute ROS XFIRERW with wind
+ ! -----------------------------
+ !
+ !
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ CALL FIRE_RATEOFSPREAD( XFMFUELTYPE, XFMR0, XFMRFA, XFMWF0, XFMR00, XFIREWIND, XGRADLSPHIX, XGRADLSPHIY, &
+ XFMGRADOROX, XFMGRADOROY, XFIRERW )
+ END SELECT
+ CALL SECOND_MNH2( ZROSWINDTIME2 )
+ XROSWINDPERF = XROSWINDPERF + ZROSWINDTIME2 - ZGRADTIME2
+ !
+ !* 2.1.8 Integrate model on atm time step to propagate
+ ! ---------------------------------------------
+ !
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ CALL FIRE_PROPAGATE( XLSPHI, XBMAP, XFMIGNITION, XFMWALKIG, XGRADLSPHIX, XGRADLSPHIY, XTSTEP, XFIRERW )
+ END SELECT
+ CALL SECOND_MNH2( ZPROPAGTIME2 )
+ XPROPAGPERF = XPROPAGPERF + ZPROPAGTIME2 - ZROSWINDTIME2
+ !
+ CASE('FIR2ATM')
+ !
+ CALL SECOND_MNH2( ZPROPAGTIME1 )
+ CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( XLSPHI, XBMAP, XTSTEP )
+ CALL SECOND_MNH2( ZPROPAGTIME2 )
+ XPROPAGPERF = XPROPAGPERF + ZPROPAGTIME2 - ZPROPAGTIME1
+ XGRADPERF(:) = 0.
+ !
+ END SELECT
+ !
+ !* 2.1.8 Compute fluxes
+ ! --------------
+ !
+ SELECT CASE (CFIRE_CPL_MODE)
+ CASE('2WAYCPL','FIR2ATM')
+ CALL SECOND_MNH2( ZFLUXTIME1 )
+ ! 2 way coupling
+ CALL FIRE_HEATFLUXES( XLSPHI, XBMAP, XFIRETAU, XTSTEP, XFLUXPARAMH, XFLUXPARAMW, XFMFLUXHDH, XFMFLUXHDW, XFMASE, XFMAWC )
+ ! vertical distribution of fire heat fluxes
+ CALL FIRE_VERTICALFLUXDISTRIB( XFMFLUXHDH, XFMFLUXHDW, XRTHS, XRRS, ZSFTS, XEXNREF, XRHODJ, XRT, XRHODREF )
+ !
+ CALL SECOND_MNH2( ZFLUXTIME2 )
+ XFLUXPERF = XFLUXPERF + ZFLUXTIME2 - ZFLUXTIME1
+ CASE DEFAULT
+ XFLUXPERF(:) = 0.
+ END SELECT
+ ! get end time
+ CALL SECOND_MNH2( ZFIRETIME2 )
+ ! add to Blaze time
+ XFIREPERF = XFIREPERF + ZFIRETIME2 - ZFIRETIME1
+END IF
!* conversion from H (W/m2) to w'Theta'
!
PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
@@ -795,6 +975,12 @@ IF (LDIAG_IN_RUN) THEN
CALL CLEANLIST_ll(TZFIELDSURF_ll)
END IF
!
+IF (LBLAZE) THEN
+ IF (KTCOUNT <= 1) THEN
+ DEALLOCATE(ZFIREFUELMAP)
+ END IF
+ CALL CLEANLIST_ll(TZFIELDFIRE_ll)
+END IF
!==================================================================================
!
CONTAINS
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 42447401a055a7354fec871864ee0e837084522b..3d9aa05443f72ccb3c8beb9d0530ce48c56ed393 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -81,7 +81,7 @@ END MODULE MODI_INI_MODEL_n
!! FMCLOS : to close a FM-file
!! SET_REF : to initialize reference state for anelastic approximation
!! INI_DYNAMICS: to initialize parameters for the dynamics
-!! INI_TKE_EPS : to initialize the TKE
+!! INI_TKE_EPS : to initialize the TKE
!! SET_DIRCOS : to compute the director cosinus of the orography
!! INI_RADIATIONS : to initialize radiation computations
!! CH_INIT_CCS: to initialize the chemical core system
@@ -130,7 +130,7 @@ END MODULE MODI_INI_MODEL_n
!!
!!
!!
-!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
+!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
!! uses module MODD_CONF_n (configuration variables)
!! Module MODN_LUNIT_n : contains declaration of namelist NAM_LUNITn and
!! uses module MODD_LUNIT_n (Logical units)
@@ -139,9 +139,9 @@ END MODULE MODI_INI_MODEL_n
!! Module MODN_PARAM_n : contains declaration of namelist NAM_PARAMn and
!! uses module MODD_PARAM_n (control of physical
!! parameterization)
-!! Module MODN_LBC_n : contains declaration of namelist NAM_LBCn and
+!! Module MODN_LBC_n : contains declaration of namelist NAM_LBCn and
!! uses module MODD_LBC_n (lateral boundaries)
-!! Module MODN_TURB_n : contains declaration of namelist NAM_TURBn and
+!! Module MODN_TURB_n : contains declaration of namelist NAM_TURBn and
!! uses module MODD_TURB_n (turbulence scheme)
!! Module MODN_PARAM_RAD_n: contains declaration of namelist NAM_PARAM_RADn
!!
@@ -185,8 +185,8 @@ END MODULE MODI_INI_MODEL_n
!! the ECMWF radiation code
!! Modification Sept. 13, 1995 (J.-P. Pinty) control the allocation of the
!! arrays of MODD_GR_FIELD_n
-!! Modification Nove. 17, 1995 (J.Stein) control of the control !!
-!! March 01, 1996 (J. Stein) add the cloud fraction
+!! Modification Nove. 17, 1995 (J.Stein) control of the control !!
+!! March 01, 1996 (J. Stein) add the cloud fraction
!! April 03, 1996 (J. Stein) unify the ISBA and TSZ0 cases
!! Modification 13/12/95 (M. Georgelin) add the forcing variables in
!! the call read_field, and their
@@ -247,16 +247,16 @@ END MODULE MODI_INI_MODEL_n
!! Oct. 2010 (J.Escobar) check if local domain not to small for NRIMX NRIMY
!! Nov. 2010 (J.Escobar) PGI BUG , add SIZE(CSV) to init_ground routine
!! Nov. 2009 (C. Barthe) add call to INI_ELEC_n
-!! Mar. 2010 (M. Chong) add small ions
+!! Mar. 2010 (M. Chong) add small ions
!! Apr. 2011 (M. Chong) correction of RESTART (ELEC)
!! June 2011 (B.Aouizerats) Prognostic aerosols
-!! June 2011 (P.Aumond) Drag of the vegetation
+!! June 2011 (P.Aumond) Drag of the vegetation
!! + Mean fields
!! July 2013 (Bosseur & Filippi) Adds Forefire
-!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
!! JAn. 2015 (F. Brosse) bug in allocate XACPRAQ
!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! V. Masson Feb 2015 replaces, for aerosols, cover fractions by sea, town, bare soil fractions
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! J.Escobar : 01/06/2016 : correct check limit of NRIM versus local subdomain size IDIM
@@ -266,15 +266,15 @@ END MODULE MODI_INI_MODEL_n
!! M.Leriche 2016 Chemistry
!! 10/2016 M.Mazoyer New KHKO output fields
!! 10/2016 (C.Lac) Add max values
-!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
+!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
!! M.Leriche 2016 Chemistry
-!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
+!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
!! 09/2017 Q.Rodier add LTEND_UV_FRC
!! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! V. Vionnet : 18/07/2017 : add blowing snow scheme
-!! 01/18 J.Colin Add DRAG
+!! V. Vionnet : 18/07/2017 : add blowing snow scheme
+!! 01/18 J.Colin Add DRAG
! P. Wautelet 29/01/2019: bug: add missing zero-size allocations
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
! P. Wautelet 13/02/2019: initialize XALBUV even if no radiation (needed in CH_INTERP_JVALUES)
@@ -293,6 +293,7 @@ END MODULE MODI_INI_MODEL_n
! F. Auguste 02/2021: add IBM
! T.Nigel 02/2021: add turbulence recycling
! J.L.Redelsperger 06/2011: OCEAN case
+! A. Costes 12/2021: Blaze fire model
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -413,6 +414,7 @@ USE MODE_MPPDB
USE MODE_MSG
USE MODE_SPLITTINGZ_ll, only: GET_DIM_EXTZ_ll
USE MODE_TYPE_ZDIFFU
+USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODI_CH_AER_MOD_INIT
USE MODI_CH_INIT_BUDGET_n
@@ -476,6 +478,7 @@ USE YOERDI , ONLY :RCCO2
#endif
#endif
!
+USE MODD_FIRE
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -552,7 +555,7 @@ REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
-REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
@@ -560,7 +563,8 @@ REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTH
REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
!
INTEGER :: IIB,IJB,IIE,IJE,IDIMX,IDIMY,IMI
-!
+! Fire model
+INTEGER :: INBPARAMSENSIBLE, INBPARAMLATENT
!-------------------------------------------------------------------------------
!
!* 0. PROLOGUE
@@ -710,15 +714,16 @@ END IF
!
!* 2.4 Update NSV and floating indices for the current model
!
-!
-CALL UPDATE_NSV(KMI)
+!
+CALL UPDATE_NSV(KMI)
+!
!-------------------------------------------------------------------------------
!
!* 3. ALLOCATE MEMORY
! -----------------
! * Module RECYCL
!
-IF (LRECYCL) THEN
+IF (LRECYCL) THEN
!
NR_COUNT = 0
!
@@ -1348,7 +1353,7 @@ IF ( LHORELAX_UVWTH ) THEN
END IF ! END OF THE IF STRUCTURE ON THE MODEL DIMENSION
!
!
-IF ( KMI > 1 ) THEN
+IF ( KMI > 1 ) THEN
! it has been assumed that the THeta field used the largest rim area compared
! to the others prognostic variables, if it is not the case, you must change
! these lines
@@ -1475,8 +1480,8 @@ ELSE
#endif
END IF
-ALLOCATE(XSW_BANDS (NSWB_MNH))
-ALLOCATE(XLW_BANDS (NLWB_MNH))
+ALLOCATE(XSW_BANDS (NSWB_MNH))
+ALLOCATE(XLW_BANDS (NLWB_MNH))
ALLOCATE(XZENITH (IIU,IJU))
ALLOCATE(XAZIM (IIU,IJU))
ALLOCATE(XALBUV (IIU,IJU))
@@ -1882,7 +1887,7 @@ NDT_2_WAY(KMI)=4
!
!-------------------------------------------------------------------------------
!
-!* 8. INITIALIZE DATA FOR JVALUES AND AEROSOLS
+!* 8. INITIALIZE DATA FOR JVALUES AND AEROSOLS
!
IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
IF ((KMI==1).AND.(CPROGRAM == "MESONH".OR.CPROGRAM == "DIAG ")) &
@@ -1898,6 +1903,203 @@ IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0))
!
IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
!
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. FIRE initializations
+! --------------------
+!
+IF(LBLAZE) THEN
+ !
+ ! 9.1 Array allocation
+ ! ----------------
+ !
+ ! Level Set function
+ ALLOCATE(XLSPHI(IIU,IJU,NREFINX*NREFINY)); XLSPHI(:,:,:) = 0.
+
+ ! BMap array
+ ! BMap default value
+ ! -1 = The fire is not here yet
+ ALLOCATE(XBMAP(IIU,IJU,NREFINX*NREFINY)); XBMAP(:,:,:) = -1.
+
+ ! A array
+ ALLOCATE(XFMRFA(IIU,IJU,NREFINX*NREFINY)); XFMRFA(:,:,:) = 0.
+
+ ! Wf0 array
+ ALLOCATE(XFMWF0(IIU,IJU,NREFINX*NREFINY)); XFMWF0(:,:,:) = 0.
+
+ ! R0 array
+ ALLOCATE(XFMR0(IIU,IJU,NREFINX*NREFINY)); XFMR0(:,:,:) = 0.
+
+ ! r00 array
+ ALLOCATE(XFMR00(IIU,IJU,NREFINX*NREFINY)); XFMR00(:,:,:) = 0.
+
+ ! Ignition
+ ! Default value as 1E6 : Ignition long after simulation end time
+ ! 1E6 should be enough as it is more than 11 days
+ ALLOCATE(XFMIGNITION(IIU,IJU,NREFINX*NREFINY)); XFMIGNITION(:,:,:) = 1.E6
+
+ ! Fuel type
+ ALLOCATE(XFMFUELTYPE(IIU,IJU,NREFINX*NREFINY)); XFMFUELTYPE(:,:,:) = 0.
+
+ ! Residence time function
+ ALLOCATE(XFIRETAU(IIU,IJU,NREFINX*NREFINY)); XFIRETAU(:,:,:) = 0.
+
+ ! Rate of spread with wind
+ ALLOCATE(XFIRERW(IIU,IJU,NREFINX*NREFINY)); XFIRERW(:,:,:) = 0.
+
+ ! Sensible heat flux parameters
+ ! get number of parameters
+ SELECT CASE(CHEAT_FLUX_MODEL)
+ CASE('CST')
+ ! 1 parameter for model : nominal injection value
+ INBPARAMSENSIBLE = 1
+
+ CASE('EXP')
+ ! 2 parameters for model : Max value and characteristic time
+ INBPARAMSENSIBLE = 2
+
+ CASE('EXS')
+ ! 3 parameters for model : Max value and characteristic time, smoldering injection value
+ INBPARAMSENSIBLE = 3
+ END SELECT
+
+ ALLOCATE(XFLUXPARAMH(IIU,IJU,NREFINX*NREFINY,INBPARAMSENSIBLE));
+ XFLUXPARAMH(:,:,:,:) = 0.
+
+ ! Latent heat flux parameters
+ ! get number of parameters
+ SELECT CASE(CLATENT_FLUX_MODEL)
+ CASE('CST')
+ ! 1 parameter for model : nominal injection value
+ INBPARAMLATENT = 1
+
+ CASE('EXP')
+ ! 2 parameters for model : Max value and characteristic time
+ INBPARAMLATENT = 2
+ END SELECT
+
+ ALLOCATE(XFLUXPARAMW(IIU,IJU,NREFINX*NREFINY,INBPARAMLATENT));
+ XFLUXPARAMW(:,:,:,:) = 0.
+
+ ! Available Sensible energy
+ ALLOCATE(XFMASE(IIU,IJU,NREFINX*NREFINY)); XFMASE(:,:,:) = 0.
+
+ ! Available Latent energy
+ ALLOCATE(XFMAWC(IIU,IJU,NREFINX*NREFINY)); XFMAWC(:,:,:) = 0.
+
+ ! Walking Ignition map (Arrival time matrix for ignition)
+ ALLOCATE(XFMWALKIG(IIU,IJU,NREFINX*NREFINY)); XFMWALKIG(:,:,:) = -1.
+
+ ! Sensible heat flux (W/m2)
+ ALLOCATE(XFMFLUXHDH(IIU,IJU,NREFINX*NREFINY)); XFMFLUXHDH(:,:,:) = 0.
+
+ ! Latent heat flux (kg/s/m2)
+ ALLOCATE(XFMFLUXHDW(IIU,IJU,NREFINX*NREFINY)); XFMFLUXHDW(:,:,:) = 0.
+
+ ! filtered wind on front normal (m/s)
+ ALLOCATE(XFMHWS(IIU,IJU,NREFINX*NREFINY)); XFMHWS(:,:,:) = 0.
+
+ ! filtered wind U (m/s)
+ ALLOCATE(XFMWINDU(IIU,IJU,NREFINX*NREFINY)); XFMWINDU(:,:,:) = 0.
+
+ ! filtered wind V (m/s)
+ ALLOCATE(XFMWINDV(IIU,IJU,NREFINX*NREFINY)); XFMWINDV(:,:,:) = 0.
+
+ ! filtered wind W (m/s)
+ ALLOCATE(XFMWINDW(IIU,IJU,NREFINX*NREFINY)); XFMWINDW(:,:,:) = 0.
+
+ ! Gradient of Level Set on x
+ ALLOCATE(XGRADLSPHIX(IIU,IJU,NREFINX*NREFINY)); XGRADLSPHIX(:,:,:) = 0.
+
+ ! Gradient of Level Set on y
+ ALLOCATE(XGRADLSPHIY(IIU,IJU,NREFINX*NREFINY)); XGRADLSPHIY(:,:,:) = 0.
+
+ ! Wind for fire
+ ALLOCATE(XFIREWIND(IIU,IJU,NREFINX*NREFINY)); XFIREWIND(:,:,:) = 0.
+
+ ! Orographic gradient on fire mesh
+ ALLOCATE(XFMGRADOROX(IIU,IJU,NREFINX*NREFINY)); XFMGRADOROX(:,:,:) = 0.
+ ALLOCATE(XFMGRADOROY(IIU,IJU,NREFINX*NREFINY)); XFMGRADOROY(:,:,:) = 0.
+ !
+ ! 9.2 Array 2d fire mesh allocation
+ ! -----------------------------
+ !
+ ! Level Set 2d
+ ALLOCATE(XLSPHI2D(IIU*NREFINX,IJU*NREFINY)); XLSPHI2D(:,:) = 0.
+ ! Gradient of Level Set on x 2d
+ ALLOCATE(XGRADLSPHIX2D(IIU*NREFINX,IJU*NREFINY)); XGRADLSPHIX2D(:,:) = 0.
+
+ ! Gradient of Level Set on y 2d
+ ALLOCATE(XGRADLSPHIY2D(IIU*NREFINX,IJU*NREFINY)); XGRADLSPHIY2D(:,:) = 0.
+
+ ! Level Set mask on x 2d
+ ALLOCATE(XGRADMASKX(IIU*NREFINX,IJU*NREFINY)); XGRADMASKX(:,:) = 0.
+
+ ! Level Set mask on y 2d
+ ALLOCATE(XGRADMASKY(IIU*NREFINX,IJU*NREFINY)); XGRADMASKY(:,:) = 0.
+
+ ! burnt surface ratio 2d
+ ALLOCATE(XSURFRATIO2D(IIU*NREFINX,IJU*NREFINY)); XSURFRATIO2D(:,:) = 0.
+
+ ! Level Set diffusuon x 2d
+ ALLOCATE(XLSDIFFUX2D(IIU*NREFINX,IJU*NREFINY)); XLSDIFFUX2D(:,:) = 0.
+
+ ! Level Set diffusion y 2d
+ ALLOCATE(XLSDIFFUY2D(IIU*NREFINX,IJU*NREFINY)); XLSDIFFUY2D(:,:) = 0.
+
+ ! ROS diffusion 2d
+ ALLOCATE(XFIRERW2D(IIU*NREFINX,IJU*NREFINY)); XFIRERW2D(:,:) = 0.
+ !
+ ! 9.3 Compute fire mesh size
+ ! ----------------------
+ !
+ XFIREMESHSIZE(1) = (XXHAT(2) - XXHAT(1)) / REAL(NREFINX)
+ XFIREMESHSIZE(2) = (XYHAT(2) - XYHAT(1)) / REAL(NREFINY)
+ !
+ELSE
+ !
+ ! 9.4 Default allocation
+ ! ------------------
+ !
+ ! 3d array
+ ALLOCATE(XLSPHI(0,0,0))
+ ALLOCATE(XBMAP(0,0,0))
+ ALLOCATE(XFMRFA(0,0,0))
+ ALLOCATE(XFMR0(0,0,0))
+ ALLOCATE(XFMWF0(0,0,0))
+ ALLOCATE(XFMR00(0,0,0))
+ ALLOCATE(XFMIGNITION(0,0,0))
+ ALLOCATE(XFMFUELTYPE(0,0,0))
+ ALLOCATE(XFIRETAU(0,0,0))
+ ALLOCATE(XFIRERW(0,0,0))
+ ALLOCATE(XFLUXPARAMH(0,0,0,0))
+ ALLOCATE(XFLUXPARAMW(0,0,0,0))
+ ALLOCATE(XFMASE(0,0,0))
+ ALLOCATE(XFMAWC(0,0,0))
+ ALLOCATE(XFMWALKIG(0,0,0))
+ ALLOCATE(XFMFLUXHDH(0,0,0))
+ ALLOCATE(XFMFLUXHDW(0,0,0))
+ ALLOCATE(XGRADLSPHIX(0,0,0))
+ ALLOCATE(XGRADLSPHIY(0,0,0))
+ ALLOCATE(XFIREWIND(0,0,0))
+ ALLOCATE(XFMGRADOROX(0,0,0))
+ ALLOCATE(XFMGRADOROY(0,0,0))
+ ! 2d array
+ ALLOCATE(XLSPHI2D(0,0))
+ ALLOCATE(XGRADLSPHIX2D(0,0))
+ ALLOCATE(XGRADLSPHIY2D(0,0))
+ ALLOCATE(XGRADMASKX(0,0))
+ ALLOCATE(XGRADMASKY(0,0))
+ ALLOCATE(XSURFRATIO2D(0,0))
+ ALLOCATE(XLSDIFFUX2D(0,0))
+ ALLOCATE(XLSDIFFUY2D(0,0))
+ ALLOCATE(XFIRERW2D(0,0))
+END IF
+!
+!
!-------------------------------------------------------------------------------
!
!* 9. INITIALIZE THE PROGNOSTIC FIELDS
@@ -1930,7 +2132,8 @@ CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, &
ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, &
- XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS )
+ XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS, &
+ XLSPHI, XBMAP, XFMASE, XFMAWC, XFMWINDU, XFMWINDV, XFMWINDW, XFMHWS )
!
!-------------------------------------------------------------------------------
@@ -1975,7 +2178,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 12. INITIALIZE THE MICROPHYSICS
+!* 12. INITIALIZE THE MICROPHYSICS
! ----------------------------
!
IF (CELEC == 'NONE') THEN
@@ -1983,7 +2186,7 @@ IF (CELEC == 'NONE') THEN
!
!-------------------------------------------------------------------------------
!
-!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY
+!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY
! --------------------------------------
!
ELSE
@@ -1994,7 +2197,7 @@ ELSE
WRITE (UNIT=ILUOUT,&
FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')&
NSV_ELECBEG, NSV_ELECEND
-!
+!
IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
@@ -2077,6 +2280,12 @@ IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
ENDDO
!
#endif
+! Blaze smoke
+DO JSV=NSV_FIREBEG,NSV_FIREEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ENDDO
+!
DO JSV=NSV_CSBEG,NSV_CSEND
XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
@@ -2144,7 +2353,7 @@ IF ( KMI > 1) THEN
DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT, &
LSLEVE,XLEN1,XLEN2, &
DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSZWSM, &
- DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, &
+ DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, &
DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
@@ -2217,7 +2426,7 @@ CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
LMASK_RELAX,XKURELAX,XKVRELAX,XKWRELAX, &
XDK2U,XDK4U,XDK2TH,XDK4TH,XDK2SV,XDK4SV, &
LZDIFFU,XZDIFFU_HALO2, &
- XBFB,XBF_SXP2_YP1_Z )
+ XBFB,XBF_SXP2_YP1_Z )
!
!
!* 16.1 Initialize the XDRAG array
@@ -2349,7 +2558,7 @@ IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN
XSCA_ALB = ZSCA_ALB
XEMIS = ZEMIS
XTSRAD = ZTSRAD
- CALL MNHGET_SURF_PARAM_n (PSEA=XSEA)
+ CALL MNHGET_SURF_PARAM_n (PSEA=XSEA)
END IF
ELSE
!* fields not physically necessary, but must be initialized
@@ -2476,7 +2685,7 @@ ELSE
ALLOCATE (XOZON(0,0,0))
ALLOCATE (XAER(0,0,0,0))
ALLOCATE (XDST_WL(0,0,0,0))
- ALLOCATE (XAER_CLIM(0,0,0,0))
+ ALLOCATE (XAER_CLIM(0,0,0,0))
END IF
!
!
@@ -2581,7 +2790,7 @@ CALL INI_POSPROFILER_n(XTSTEP, XSEGLEN, NRR, NSV, &
!
!-------------------------------------------------------------------------------
!
-!* 26. Prognostic aerosols
+!* 26. Prognostic aerosols
! ------------------------
!
IF ( ( CRAD=='ECMW' .OR. CRAD=='ECRA' ) .AND. CAOP=='EXPL' .AND. LORILAM ) THEN
@@ -2596,7 +2805,7 @@ IF ( ( CRAD=='ECMW' .OR. CRAD=='ECRA' ) .AND. CAOP=='EXPL' .AND. LORILAM ) THEN
CALL INI_AEROSET6
END IF
#ifdef MNH_FOREFIRE
-!
+!
!-------------------------------------------------------------------------------
!
!* 27. FOREFIRE initializations
@@ -2697,4 +2906,3 @@ ELSE
END IF
!
END SUBROUTINE INI_MODEL_n
-
diff --git a/src/MNH/ini_nsv.f90 b/src/MNH/ini_nsv.f90
index 8f1da03c448a18c27de445bd0bd347e298e29c06..2b29b251ca2f9349f74051b902db0c45efc5f9b6 100644
--- a/src/MNH/ini_nsv.f90
+++ b/src/MNH/ini_nsv.f90
@@ -70,6 +70,7 @@ END MODULE MODI_INI_NSV
! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! A. Costes 12/2021: smoke tracer for fire model
!!
!-------------------------------------------------------------------------------
!
@@ -101,6 +102,10 @@ USE MODD_ELEC_DESCR, ONLY: CELECNAMES
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
+!Blaze fire model
+USE MODD_FIRE
+USE MODD_DYN_n, ONLY : LHORELAX_SVFIRE
+!
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN
USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -371,6 +376,20 @@ ELSE
NSV_FFEND_A(KMI)= 0
END IF
#endif
+! Blaze tracers
+IF (LBLAZE .AND. NNBSMOKETRACER .GT. 0) THEN
+ NSV_FIRE_A(KMI) = NNBSMOKETRACER
+ NSV_FIREBEG_A(KMI) = ISV+1
+ NSV_FIREEND_A(KMI) = ISV+NSV_FIRE_A(KMI)
+ ISV = NSV_FIREEND_A(KMI)
+ELSE
+ NSV_FIRE_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FIREBEG_A(KMI)= 1
+ NSV_FIREEND_A(KMI)= 0
+END IF
+!
! Conditional sampling variables
IF (LCONDSAMP) THEN
NSV_CS_A(KMI) = NCONDSAMP
@@ -636,6 +655,9 @@ LHORELAX_SV(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=LHORELAX_SVPP
IF (LFOREFIRE) &
LHORELAX_SV(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=LHORELAX_SVFF
#endif
+! Blaze Fire pollutants
+IF (LBLAZE) &
+LHORELAX_SV(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=LHORELAX_SVFIRE
! Conditional sampling
IF (LCONDSAMP) &
LHORELAX_SV(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=LHORELAX_SVCS
@@ -681,6 +703,9 @@ IF (LPASPOL) XSVMIN(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=0.
#ifdef MNH_FOREFIRE
IF (LFOREFIRE) XSVMIN(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=0.
#endif
+! Blaze smoke
+IF (LBLAZE) XSVMIN(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=0.
+!
IF (LCONDSAMP) XSVMIN(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=0.
IF (LBLOWSNOW) XSVMIN(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=XMNH_TINY
!
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index fe1fe7a55f86b4a023a8096e9fc7522616d2588b..b8e1dab02755baa6cd163e3e9cbf909e674d3ad9 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -31,23 +31,23 @@ END MODULE MODI_INI_SEG_n
SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
! #############################################################
!
-!!**** *INI_SEG_n * - routine to read and update the descriptor files for
+!!**** *INI_SEG_n * - routine to read and update the descriptor files for
!! model KMI
!!
!! PURPOSE
!! -------
! The purpose of this routine is to read the descriptor files in the
! following order :
-! - DESFM file which gives informations about the initial file
-! (i.e. the description of the segment that produced the initial file
+! - DESFM file which gives informations about the initial file
+! (i.e. the description of the segment that produced the initial file
! or the description of the preinitialisation that created the initial file)
! - EXSEG file which gives informations about the segment to perform.
!
! Informations in EXSEG file are completed by DESFM file informations
-! and if the informations are not in DESFM file, they are set
-! to default values.
+! and if the informations are not in DESFM file, they are set
+! to default values.
!
-! The descriptor file EXSEG corresponding to the segment of simulation
+! The descriptor file EXSEG corresponding to the segment of simulation
! to be performed, is then updated with the combined informations.
! We also store in the updated EXSEG file, the informations on the status
! of the different variables ( skip, init, read) in the namelist NAM_GETn,
@@ -58,41 +58,41 @@ END MODULE MODI_INI_SEG_n
!
! In order not to duplicate the routines called by ini_seg, we use the
! modules modd, corresponding to the first model to store the informations
-! read on the different files ( DESFM and EXSEG ). The final filling of
-! the modules modd (MODD_CONFn ....) will be realized in the subroutine
-! INI_MODELn. The goal of the INI_SEG_n part of the initialization is to
-! built the final EXSEG, which will be associated to the LFI files
-! generated during the segment ( and therefore not to fill the modd).
-!
+! read on the different files ( DESFM and EXSEG ). The final filling of
+! the modules modd (MODD_CONFn ....) will be realized in the subroutine
+! INI_MODELn. The goal of the INI_SEG_n part of the initialization is to
+! built the final EXSEG, which will be associated to the LFI files
+! generated during the segment ( and therefore not to fill the modd).
+!
!
!!** METHOD
!! ------
!! For a nested model of index KMI :
!! - Logical unit numbers are associated to output-listing file and
!! descriptor EXSEG file by FMATTR. Then these files are opened.
-!! The name of the initial file is read in EXSEG file.
+!! The name of the initial file is read in EXSEG file.
!! - Default values are supplied for variables in descriptor files
!! (by DEFAULT_DESFM).
!! - The Initial file (LFIFM + DESFM) is opened by IO_File_open.
-!! - The descriptor DESFM file is read (by READ_DESFM_n).
+!! - The descriptor DESFM file is read (by READ_DESFM_n).
!! - The descriptor file EXSEG is read (by READ_EXSEG_n) and coherence
-!! between the initial file and the description of segment is also checked
+!! between the initial file and the description of segment is also checked
!! in this routine.
!! - If there is more than one model the EXSEG file is updated
!! (by WRITE_DESFM$n). This routine prints also EXSEG content on
-!! output-listing.
+!! output-listing.
!! - If there is only one model (i.e. no grid-nesting),
!! EXSEG file is also closed (logical unit number associated with this
-!! file is also released by FMFREE).
-!!
-!!
+!! file is also released by FMFREE).
+!!
+!!
!!
!! EXTERNAL
!! --------
-!! FMATTR : to associate a logical unit number to a file
+!! FMATTR : to associate a logical unit number to a file
!! IO_File_open : to open descriptor file or LFI file
!! DEFAULT_DESFM1: to set default values
-!! READ_DESFM_n : to read a DESFM file
+!! READ_DESFM_n : to read a DESFM file
!! READ_EXSEG_n : to read a EXSEG file
!! WRITE_DESFM1 : to write the DESFM part of the future outputs
!! FMFREE : to release a logical unit number linked to a file
@@ -108,19 +108,19 @@ END MODULE MODI_INI_SEG_n
!!
!! Module MODD_CONF : contains configuration variables
!! CCONF : Configuration of models
-!! NMODEL : Number of nested models
+!! NMODEL : Number of nested models
!! NVERB : Level of informations on output-listing
!! 0 for minimum of prints
!! 5 for intermediate level of prints
-!! 10 for maximum of prints
+!! 10 for maximum of prints
!!
!! Module MODN_LUNIT1 : contains declarations of namelist NAMLUNITMN
-!! and module MODD_LUNIT1
+!! and module MODD_LUNIT1
!!
!! REFERENCE
!! ---------
!! Book2 of documentation (routine INI_SEG)
-!!
+!!
!!
!! AUTHOR
!! ------
@@ -128,7 +128,7 @@ END MODULE MODI_INI_SEG_n
!!
!! MODIFICATIONS
!! -------------
-!! Original 07/06/94
+!! Original 07/06/94
!! Modification 26/10/94 remove the NAM_GETn from the namelist present
!! in the EXSEG file (J.Stein)
!! 11/01/95 change the read_exseg and desfm CALLS to add
@@ -140,7 +140,7 @@ END MODULE MODI_INI_SEG_n
!! (J. Stein)
!! 11/04/96 add the ice conc. control (J.-P. Pinty)
!! 11/01/97 add the deep convection control (J.-P. Pinty)
-!! 17/07/96 correction for WRITE_DESFM1 call (J. P. Lafore)
+!! 17/07/96 correction for WRITE_DESFM1 call (J. P. Lafore)
!! 22/07/96 PTSTEP_ALL introduction for nesting (J. P. Lafore)
!! 7/08/98 // (V. Ducrocq)
!! 02/08/99 remove unused argument for read_desfm (J. Stein)
@@ -156,8 +156,8 @@ END MODULE MODI_INI_SEG_n
!! 02/2012 add GFOREFIRE (Pialat/Tulet)
!! 05/2014 missing reading of IMASDEV before COUPLING
!! test (Escobar)
-!! 10/02/15 remove ABORT in parallel case for SPAWNING
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 10/02/15 remove ABORT in parallel case for SPAWNING
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 01/2015 add GLNOX_EXPLICIT (C. Barthe)
!! 04/2016 add ABORT if CINIFILEPGD is not specified (G.Delautier)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
@@ -196,10 +196,11 @@ USE MODI_WRITE_DESFM_n
!
USE MODN_CONFIO, ONLY: NAM_CONFIO
USE MODN_LUNIT_n
+USE MODN_FIRE
!
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
+!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KMI !Model index
TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
@@ -212,7 +213,7 @@ LOGICAL :: GFOUND ! Return code when searching namelist
CHARACTER (LEN=28) :: YINIFILE ! name of initial file
CHARACTER (LEN=2) :: YMI ! string for model index
INTEGER :: ILUOUT ! Logical unit number
- ! associated with TLUOUT
+ ! associated with TLUOUT
!
INTEGER :: IRESP,ILUSEG ! File management variables
CHARACTER (LEN=5) :: YCONF ! Local variables which have
@@ -222,7 +223,7 @@ LOGICAL :: GUSERS,GUSERG,GUSERH,GUSECI ! MODD_CONFn, MODD_PARAMn,
LOGICAL :: GUSECHEM ! flag for chemistry
LOGICAL :: GUSECHAQ ! flag for aq. phase chemistry
LOGICAL :: GUSECHIC ! flag for ice phase chemistry
-LOGICAL :: GCH_PH ! flag for pH
+LOGICAL :: GCH_PH ! flag for pH
LOGICAL :: GCH_CONV_LINOX
LOGICAL :: GDUST
LOGICAL,DIMENSION(JPMODELMAX) :: GDEPOS_DST, GDEPOS_SLT, GDEPOS_AER
@@ -230,19 +231,20 @@ LOGICAL :: GSALT
LOGICAL :: GORILAM
LOGICAL :: GLG
LOGICAL :: GPASPOL
+LOGICAL :: GFIRE
#ifdef MNH_FOREFIRE
LOGICAL :: GFOREFIRE
#endif
LOGICAL :: GCONDSAMP
LOGICAL :: GBLOWSNOW
-LOGICAL :: GCHTRANS
+LOGICAL :: GCHTRANS
LOGICAL :: GLNOX_EXPLICIT ! flag for LNOx
! These variables
- ! are used to locally store
-INTEGER :: ISV ! the value read in DESFM
+ ! are used to locally store
+INTEGER :: ISV ! the value read in DESFM
INTEGER :: IRIMX,IRIMY ! number of points for the
! horizontal relaxation
-CHARACTER (LEN=4) :: YTURB ! file in order to check the
+CHARACTER (LEN=4) :: YTURB ! file in order to check the
CHARACTER (LEN=4) :: YRAD ! corresponding informations
CHARACTER (LEN=4) :: YTOM ! read in EXSEG file.
LOGICAL :: GRMC01
@@ -296,7 +298,7 @@ ELSE IF (CPROGRAM=='DIAG ') THEN
CALL IO_File_open(TINIFILE_n)
TPINIFILE => TINIFILE_n
TZFILE_DES => TPINIFILE%TDESFILE
-!
+!
!* 1.4 Other program cases
! -------------------
!
@@ -320,7 +322,7 @@ CALL DEFAULT_DESFM_n(KMI)
! --------------------------------------------
!
CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND)
-IF (GFOUND) THEN
+IF (GFOUND) THEN
CALL INIT_NAM_LUNITn
READ(UNIT=ILUSEG,NML=NAM_LUNITn)
CALL UPDATE_NAM_LUNITn
@@ -337,6 +339,9 @@ IF (CPROGRAM=='MESONH') THEN
CALL POSNAM(ILUSEG,'NAM_CONFIO',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
CALL IO_Config_set()
+ ! read Blaze namelist to get NREFINX and NREFINY before INI_FIELD_LIST
+ CALL POSNAM(ILUSEG,'NAM_FIRE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIRE)
END IF
HINIFILEPGD=CINIFILEPGD_n
YINIFILE=CINIFILE_n
@@ -355,12 +360,12 @@ CALL READ_DESFM_n(KMI,TPINIFILE,YCONF,GFLAT,GUSERV,GUSERC, &
GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM,GUSECHAQ,&
GUSECHIC,GCH_PH,GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST, &
GDEPOS_DST, GCHTRANS, GORILAM, &
- GDEPOS_AER, GLG, GPASPOL, &
+ GDEPOS_AER, GLG, GPASPOL,GFIRE, &
#ifdef MNH_FOREFIRE
GFOREFIRE, &
#endif
GLNOX_EXPLICIT, &
- GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
+ GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS )
!
!-------------------------------------------------------------------------------
@@ -407,8 +412,8 @@ END IF
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','')
END IF
-IF (KMI == 1) THEN
-! Read the geometry kind
+IF (KMI == 1) THEN
+! Read the geometry kind
CALL IO_Field_read(TPINIFILE,'CARTESIAN',LCARTESIAN)
! Read the thinshell approximation
CALL IO_Field_read(TPINIFILE,'THINSHELL',LTHINSHELL)
@@ -438,7 +443,7 @@ END IF
!* 7. READ EXSEG FILE
! ---------------
! We pass by arguments the informations read in DESFM descriptor to the
-! routine which read related informations in the EXSEG descriptor in order to
+! routine which read related informations in the EXSEG descriptor in order to
! check coherence between both informations.
!
CALL IO_Field_read(TPINIFILE,'LOCEAN',LOCEAN,IRESP)
@@ -448,14 +453,14 @@ CALL READ_EXSEG_n(KMI,TZFILE_DES,YCONF,GFLAT,GUSERV,GUSERC, &
GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM, &
GUSECHAQ,GUSECHIC,GCH_PH, &
GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST,GDEPOS_DST,GCHTRANS, &
- GORILAM,GDEPOS_AER,GLG,GPASPOL, &
+ GORILAM,GDEPOS_AER,GLG,GPASPOL,GFIRE, &
#ifdef MNH_FOREFIRE
GFOREFIRE, &
#endif
GLNOX_EXPLICIT, &
GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS, &
- PTSTEP_ALL,CINIFILEPGD_n )
+ PTSTEP_ALL,CSTORAGE_TYPE,CINIFILEPGD_n )
!
if ( cprogram == 'MESONH' .and. kmi == 1 ) then !Do this only once
call Fieldlist_nmodel_resize(NMODEL)
diff --git a/src/MNH/modd_dynn.f90 b/src/MNH/modd_dynn.f90
index bf719ed52d8d3120df46e26c4f15b74b4d26237e..9fc3a3e98a1e4e6d8d9f038a0658cdc6c94ad0e1 100644
--- a/src/MNH/modd_dynn.f90
+++ b/src/MNH/modd_dynn.f90
@@ -44,6 +44,7 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification 07/2017 (V. Vionnet) Add blowing snow variable
!! Modification 03/2021 (JL Redelsperger) Add logical LOCEAN
+! MOdification 12/2021 (A. COstes) Add fire model
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -137,6 +138,7 @@ TYPE DYN_t
#ifdef MNH_FOREFIRE
LOGICAL :: LHORELAX_SVFF
#endif
+ LOGICAL :: LHORELAX_SVFIRE
LOGICAL :: LHORELAX_SVCS
LOGICAL :: LHORELAX_SVSNW
LOGICAL, DIMENSION(:),POINTER :: LHORELAX_SV =>NULL()
@@ -228,6 +230,7 @@ LOGICAL, POINTER :: LHORELAX_SVPP=>NULL()
#ifdef MNH_FOREFIRE
LOGICAL, POINTER :: LHORELAX_SVFF=>NULL()
#endif
+LOGICAL, POINTER :: LHORELAX_SVFIRE=>NULL()
LOGICAL, POINTER :: LHORELAX_SVCS=>NULL()
LOGICAL, POINTER :: LHORELAX_SVSNW=>NULL()
LOGICAL, DIMENSION(:), POINTER :: LHORELAX_SV=>NULL()
@@ -337,6 +340,7 @@ LHORELAX_SVPP=>DYN_MODEL(KTO)%LHORELAX_SVPP
#ifdef MNH_FOREFIRE
LHORELAX_SVFF=>DYN_MODEL(KTO)%LHORELAX_SVFF
#endif
+LHORELAX_SVFIRE=>DYN_MODEL(KTO)%LHORELAX_SVFIRE
LHORELAX_SVCS=>DYN_MODEL(KTO)%LHORELAX_SVCS
LHORELAX_SVSNW=>DYN_MODEL(KTO)%LHORELAX_SVSNW
LHORELAX_SV=>DYN_MODEL(KTO)%LHORELAX_SV
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 49cd8d3e5860b3a96468052aabae09bc6f79be44..a9197039e15d98f867aa2c7e86d6e6ffb9c17acb 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -55,6 +55,7 @@
! P. Wautelet 14/03/2019: add XZWS_DEFAULT parameter
! S. Riette 04/2020: highLow cloud
! T. Nagel 02/2021: add fields for turbulence recycling
+! A. Costes 12/2021: add Blaze fire model variables
!!
!-------------------------------------------------------------------------------
!
@@ -129,6 +130,19 @@ TYPE FIELD_t
REAL, DIMENSION(:,:,:), POINTER :: XHLC_HCF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XHLI_HRI=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XHLI_HCF=>NULL()
+ ! Blaze fire model not shared between sub domains
+ REAL, DIMENSION(:,:,:), POINTER :: XGRADLSPHIX =>NULL() ! Grad of phi on x direction
+ REAL, DIMENSION(:,:,:), POINTER :: XGRADLSPHIY =>NULL() ! Grad of phi on y direction
+ REAL, DIMENSION(:,:,:), POINTER :: XFIREWIND =>NULL() ! Surface wind speed in spread direction
+ REAL, DIMENSION(:,:) , POINTER :: XLSPHI2D =>NULL() ! Phi on 2d grid for computation
+ REAL, DIMENSION(:,:) , POINTER :: XGRADLSPHIX2D =>NULL() ! Grad of phi on x direction on 2d grid
+ REAL, DIMENSION(:,:) , POINTER :: XGRADLSPHIY2D =>NULL() ! Grad of phi on y direction on 2d grid
+ REAL, DIMENSION(:,:) , POINTER :: XGRADMASKX =>NULL() ! Grad mask x
+ REAL, DIMENSION(:,:) , POINTER :: XGRADMASKY =>NULL() ! Grad mask y
+ REAL, DIMENSION(:,:) , POINTER :: XSURFRATIO2D =>NULL() ! Burnt surface ratio
+ REAL, DIMENSION(:,:) , POINTER :: XLSDIFFUX2D =>NULL() ! LS diffusion x
+ REAL, DIMENSION(:,:) , POINTER :: XLSDIFFUY2D =>NULL() ! LS diffusion y
+ REAL, DIMENSION(:,:) , POINTER :: XFIRERW2D =>NULL() ! ROS woth wind and slope 2d
!
END TYPE FIELD_t
@@ -174,6 +188,44 @@ REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL()
REAL, DIMENSION(:,:), POINTER :: XFLUCTUNW=>NULL(),XFLUCTVNN=>NULL(),XFLUCTUTN=>NULL(),XFLUCTVTW=>NULL()
REAL, DIMENSION(:,:), POINTER :: XFLUCTUNE=>NULL(),XFLUCTVNS=>NULL(),XFLUCTUTS=>NULL(),XFLUCTVTE=>NULL()
REAL, DIMENSION(:,:), POINTER :: XFLUCTWTW=>NULL(),XFLUCTWTN=>NULL(),XFLUCTWTE=>NULL(),XFLUCTWTS=>NULL()
+! Blaze fire model declarations
+REAL, DIMENSION(:,:,:), POINTER :: XLSPHI =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XBMAP =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMRFA =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMR0 =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMR00 =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMWF0 =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMIGNITION =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMFUELTYPE =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFIRETAU =>NULL()
+REAL, DIMENSION(:,:,:,:), POINTER :: XFLUXPARAMH =>NULL()
+REAL, DIMENSION(:,:,:,:), POINTER :: XFLUXPARAMW =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFIRERW =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMASE =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMAWC =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMWALKIG =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMFLUXHDH =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMFLUXHDW =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMHWS =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMWINDU =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMWINDV =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMWINDW =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XGRADLSPHIX =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XGRADLSPHIY =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFIREWIND =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMGRADOROX =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XFMGRADOROY =>NULL()
+!! fire grid Blaze declarations
+REAL, DIMENSION(:,:), POINTER :: XLSPHI2D =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XGRADLSPHIX2D =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XGRADLSPHIY2D =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XGRADMASKX =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XGRADMASKY =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XSURFRATIO2D =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XLSDIFFUX2D =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XLSDIFFUY2D =>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFIRERW2D =>NULL()
+! End of Blaze declaration
CONTAINS
SUBROUTINE FIELD_GOTO_MODEL(KFROM, KTO)
@@ -234,6 +286,21 @@ FIELD_MODEL(KFROM)%XHLC_HRC=>XHLC_HRC
FIELD_MODEL(KFROM)%XHLC_HCF=>XHLC_HCF
FIELD_MODEL(KFROM)%XHLI_HRI=>XHLI_HRI
FIELD_MODEL(KFROM)%XHLI_HCF=>XHLI_HCF
+! Blaze
+FIELD_MODEL(KFROM)%XGRADLSPHIY => XGRADLSPHIX
+FIELD_MODEL(KFROM)%XGRADLSPHIY => XGRADLSPHIY
+FIELD_MODEL(KFROM)%XFIREWIND => XFIREWIND
+!! 2d Blaze
+FIELD_MODEL(KFROM)%XLSPHI2D => XLSPHI2D
+FIELD_MODEL(KFROM)%XGRADLSPHIX2D => XGRADLSPHIX2D
+FIELD_MODEL(KFROM)%XGRADLSPHIY2D => XGRADLSPHIY2D
+FIELD_MODEL(KFROM)%XGRADMASKX => XGRADMASKX
+FIELD_MODEL(KFROM)%XGRADMASKY => XGRADMASKY
+FIELD_MODEL(KFROM)%XSURFRATIO2D => XSURFRATIO2D
+FIELD_MODEL(KFROM)%XLSDIFFUX2D => XLSDIFFUX2D
+FIELD_MODEL(KFROM)%XLSDIFFUY2D => XLSDIFFUY2D
+FIELD_MODEL(KFROM)%XFIRERW2D => XFIRERW2D
+!End of Blaze
!
! Current model is set to model KTO
!XZWS=>FIELD_MODEL(KTO)%XZWS !Done in FIELDLIST_GOTO_MODEL
@@ -289,6 +356,21 @@ XHLC_HRC=>FIELD_MODEL(KTO)%XHLC_HRC
XHLC_HCF=>FIELD_MODEL(KTO)%XHLC_HCF
XHLI_HRI=>FIELD_MODEL(KTO)%XHLI_HRI
XHLI_HCF=>FIELD_MODEL(KTO)%XHLI_HCF
+! Blaze
+XGRADLSPHIX => FIELD_MODEL(KTO)%XGRADLSPHIX
+XGRADLSPHIY => FIELD_MODEL(KTO)%XGRADLSPHIY
+XFIREWIND => FIELD_MODEL(KTO)%XFIREWIND
+!! 2d Blaze
+XLSPHI2D => FIELD_MODEL(KTO)%XLSPHI2D
+XGRADLSPHIX2D => FIELD_MODEL(KTO)%XGRADLSPHIX2D
+XGRADLSPHIY2D => FIELD_MODEL(KTO)%XGRADLSPHIY2D
+XGRADMASKX => FIELD_MODEL(KTO)%XGRADMASKX
+XGRADMASKY => FIELD_MODEL(KTO)%XGRADMASKY
+XSURFRATIO2D => FIELD_MODEL(KTO)%XSURFRATIO2D
+XLSDIFFUX2D => FIELD_MODEL(KTO)%XLSDIFFUX2D
+XLSDIFFUY2D => FIELD_MODEL(KTO)%XLSDIFFUY2D
+XFIRERW2D => FIELD_MODEL(KTO)%XFIRERW2D
+! End of Blaze
END SUBROUTINE FIELD_GOTO_MODEL
END MODULE MODD_FIELD_n
diff --git a/src/MNH/modd_fire.f90 b/src/MNH/modd_fire.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a43f3b617779a8cab25bf588c7b3af4d85972b3f
--- /dev/null
+++ b/src/MNH/modd_fire.f90
@@ -0,0 +1,93 @@
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ MODULE MODD_FIRE
+! ################
+!
+!!**** *MODD_FIRE* - declaration of Fire model parameters
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare Fire model parameters for all models.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains the maximum number of coupling files
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! A. Costes *Meteo France/Cerfacs*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/10/2019
+!---------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+LOGICAL , SAVE :: LBLAZE ! Flag for Fire model use, default FALSE
+
+CHARACTER(LEN=11) , SAVE :: CPROPAG_MODEL ! Fire propagation model (default SANTONI2011)
+CHARACTER(LEN=3) , SAVE :: CHEAT_FLUX_MODEL ! Sensible heat flux injection model (default CST)
+CHARACTER(LEN=3) , SAVE :: CLATENT_FLUX_MODEL ! latent heat flux injection model (default CST)
+
+CHARACTER(LEN=7) , SAVE :: CFIRE_CPL_MODE ! Coupling mode (default 2WAYCPL)
+
+CHARACTER(LEN=28) , SAVE :: CBMAPFILE ! BMap file for FIR2ATM mode (default INIFILE)
+LOGICAL , SAVE :: LINTERPWIND ! Flag for wind interpolation
+LOGICAL , SAVE :: LSGBAWEIGHT ! Flag for use of weighted average method for SubGrid Burning Area computation
+
+INTEGER , SAVE :: NFIRE_WENO_ORDER ! Weno order (1,3,5)
+INTEGER , SAVE :: NFIRE_RK_ORDER ! Runge Kutta order (1,2,3,4)
+
+INTEGER , SAVE :: NREFINX ! Refinement ratio X
+INTEGER , SAVE :: NREFINY ! Refinement ratio Y
+
+REAL , SAVE :: XCFLMAXFIRE ! Maximum CFL on fire mesh
+REAL , SAVE :: XLSDIFFUSION ! Numerical diffusion of LevelSet
+REAL , SAVE :: XROSDIFFUSION ! Numerical diffusion of ROS
+
+REAL , SAVE :: XFERR ! Flamming Energy Release ratio (between 0.5 <= FERR < 1)
+
+REAL , SAVE :: XFLUXZEXT ! Flux distribution on vertical caracteristic length
+REAL , SAVE :: XFLUXZMAX ! Flux distribution on vertical max injetion height
+
+REAL , SAVE :: XFLXCOEFTMP ! Flux multiplicator. For testing
+
+LOGICAL , SAVE :: LWINDFILTER ! Fire wind filtering flag
+CHARACTER(LEN=4) , SAVE :: CWINDFILTER ! Wind filter method (EWAM or WLIM)
+REAL , SAVE :: XEWAMTAU ! Time averaging constant for EWAM method (s)
+REAL , SAVE :: XWLIMUTH ! Thresehold wind value for WLIM method (m/s)
+REAL , SAVE :: XWLIMUTMAX ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
+
+INTEGER , SAVE :: NWINDSLOPECPLMODE ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
+
+INTEGER , SAVE :: NNBSMOKETRACER
+!
+! Parameters not in the namelist
+!
+REAL , SAVE :: XFIREMESHSIZE(2) ! Fire Mesh size [dxf,dyf]
+REAL , SAVE :: XFIREPERF(2) ! Blaze fire model performance
+REAL , SAVE :: XGRADPERF(2) ! Grad computation performance
+REAL , SAVE :: XROSWINDPERF(2) ! ROS and wind interpolation computation performance
+REAL , SAVE :: XPROPAGPERF(2) ! Propagation computation performance
+REAL , SAVE :: XFLUXPERF(2) ! Heat fluxes computation performance
+LOGICAL , SAVE :: LRESTA_ASE ! Flag for using ASE in RESTA file
+LOGICAL , SAVE :: LRESTA_AWC ! Flag for using AWC in RESTA file
+LOGICAL , SAVE :: LRESTA_EWAM ! Flag for using EWAM in RESTA file
+LOGICAL , SAVE :: LRESTA_WLIM ! Flag for using WLIM in RESTA file
+
+
+END MODULE MODD_FIRE
diff --git a/src/MNH/modd_nsv.f90 b/src/MNH/modd_nsv.f90
index 510091af5da0da39aa9b05c67b49019c68a55be7..2ec859b7dc098d4fdbe5e13d0794ccea1e87d26c 100644
--- a/src/MNH/modd_nsv.f90
+++ b/src/MNH/modd_nsv.f90
@@ -30,6 +30,7 @@
!! V. Vionnet 07/17 add blowing snow
! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! A. Costes 12/2021: add Blaze fire model smoke
!
!-------------------------------------------------------------------------------
!
@@ -145,6 +146,10 @@ INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar varia
INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
#endif
+! Blaze smoke indexes
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIRE_A = 0 ! number of Blaze smoke scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREEND_A = 0 ! NSV_FIREBEG_A...NSV_FIREEND_A
!
INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
@@ -251,6 +256,10 @@ INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
#endif
+! Blaze smoke
+INTEGER :: NSV_FIRE = 0 ! number of Blaze smoke scalar variables
+INTEGER :: NSV_FIREBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FIREEND = 0 ! NSV_FIREBEG...NSV_FIREEND
!
INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 81c19f7b279dd7dbe9de82360b62771ac6e61f7f..3d8010abc27de107c3190cee67a9a330ef5a9e00 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -272,6 +272,7 @@ END MODULE MODI_MODEL_n
! T. Nagel 01/02/2021: add turbulence recycling
! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
+! A. Costes 12/2021: add Blaze fire model
! C. Barthe 07/04/2022: deallocation of ZSEA
!!-------------------------------------------------------------------------------
!
@@ -454,6 +455,7 @@ USE MODI_WRITE_SERIES_n
USE MODI_WRITE_STATION_n
USE MODI_WRITE_SURF_ATM_N
!
+USE MODD_FIRE
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -475,7 +477,7 @@ INTEGER :: IVERB ! LFI verbosity level
LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
!
! for computing time analysis
-REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT, ZBLAZETOT
REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
CHARACTER :: YMI
INTEGER :: IPOINTS
@@ -654,6 +656,32 @@ IF (KTCOUNT == 1) THEN
CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS (:,:,:,1:NSV), 'MODEL_n::XRSVS')
CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD')
IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' )
+ ! Fire model parallel setup
+ IF (LBLAZE) THEN
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XLSPHI, 'MODEL_n::XLSPHI')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XBMAP, 'MODEL_n::XBMAP')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMRFA, 'MODEL_n::XFMRFA')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWF0, 'MODEL_n::XFMWF0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR0, 'MODEL_n::XFMR0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR00, 'MODEL_n::XFMR00')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMIGNITION, 'MODEL_n::XFMIGNITION')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFUELTYPE, 'MODEL_n::XFMFUELTYPE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRETAU, 'MODEL_n::XFIRETAU')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMH(:,:,:,1:SIZE(XFLUXPARAMH,4)), 'MODEL_n::XFLUXPARAMH')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMW(:,:,:,1:SIZE(XFLUXPARAMW,4)), 'MODEL_n::XFLUXPARAMW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRERW, 'MODEL_n::XFIRERW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMASE, 'MODEL_n::XFMASE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMAWC, 'MODEL_n::XFMAWC')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWALKIG, 'MODEL_n::XFMWALKIG')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDH, 'MODEL_n::XFMFLUXHDH')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDW, 'MODEL_n::XFMFLUXHDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMHWS, 'MODEL_n::XFMHWS')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDU, 'MODEL_n::XFMWINDU')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDV, 'MODEL_n::XFMWINDV')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDW, 'MODEL_n::XFMWINDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROX, 'MODEL_n::XFMGRADOROX')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROY, 'MODEL_n::XFMGRADOROY')
+ END IF
!
IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
!
@@ -738,6 +766,8 @@ IF (KTCOUNT == 1) THEN
XT_2WAY = 0.0_MNHTIME
!
XT_IBM_FORC = 0.0_MNHTIME
+ ! Blaze fire model
+ XFIREPERF = 0.0_MNHTIME
!
END IF
!
@@ -1340,6 +1370,10 @@ DO JSV = NSV_FFBEG,NSV_FFEND
XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
END DO
#endif
+! Blaze smoke
+DO JSV = NSV_FIREBEG,NSV_FIREEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
DO JSV = NSV_CSBEG,NSV_CSEND
XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
END DO
@@ -1391,7 +1425,7 @@ IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.&
LHORELAX_SVELEC,LHORELAX_SVLG, &
LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, &
LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, &
- LHORELAX_SVCS,LHORELAX_SVSNW, &
+ LHORELAX_SVCS,LHORELAX_SVSNW,LHORELAX_SVFIRE, &
#ifdef MNH_FOREFIRE
LHORELAX_SVFF, &
#endif
@@ -1535,6 +1569,11 @@ IF (.NOT. LSTEADYLS) THEN
ENDDO
!
#endif
+ DO JSV=NSV_FIREBEG,NSV_FIREEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
DO JSV=NSV_CSBEG,NSV_CSEND
XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
@@ -2278,6 +2317,15 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_SHADOWS,ZTOT, ' SHADOWS' ,'-')
CALL TIME_STAT_ll(XT_DCONV,ZTOT, ' DEEP CONV = '//CDCONV,'-')
CALL TIME_STAT_ll(XT_GROUND,ZTOT, ' GROUND' ,'-')
+ ! Blaze perf
+ IF (LBLAZE) THEN
+ CALL TIME_STAT_ll(XFIREPERF,ZBLAZETOT)
+ CALL TIME_STAT_ll(XFIREPERF,ZTOT, ' BLAZE' ,'~')
+ CALL TIME_STAT_ll(XGRADPERF,ZBLAZETOT, ' GRAD(PHI)' ,' ')
+ CALL TIME_STAT_ll(XROSWINDPERF,ZBLAZETOT, ' ROS & WIND' ,' ')
+ CALL TIME_STAT_ll(XPROPAGPERF,ZBLAZETOT, ' PROPAGATION' ,' ')
+ CALL TIME_STAT_ll(XFLUXPERF,ZBLAZETOT, ' HEAT FLUXES' ,' ')
+ END IF
CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
diff --git a/src/MNH/modn_fire.f90 b/src/MNH/modn_fire.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5f895b617d1d8c1e3f3ef52e638d6816f5b41ff7
--- /dev/null
+++ b/src/MNH/modn_fire.f90
@@ -0,0 +1,51 @@
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODN_FIRE
+! #################
+!
+!!**** *MODN_FIRE* - declaration of namelist NAM_FIRE
+!!
+!! PURPOSE
+!! -------
+! The purpose of this module is to specify the namelist NAM_FIRE
+! which concerns the instants for the outputs realized by all models.
+!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_FIRE : contains declaration of the variables describing
+!! the instants for the outputs
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of Meso-NH documentation (module MODD_FIRE)
+!!
+!! AUTHOR
+!! ------
+!! A. Costes *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/07/2018
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_FIRE
+!
+IMPLICIT NONE
+!
+NAMELIST/NAM_FIRE/LBLAZE,&
+CPROPAG_MODEL,CHEAT_FLUX_MODEL,CLATENT_FLUX_MODEL,XFERR,&
+NFIRE_RK_ORDER,NFIRE_WENO_ORDER,LSGBAWEIGHT,&
+NREFINX,NREFINY,XCFLMAXFIRE,CFIRE_CPL_MODE,CBMAPFILE,&
+LINTERPWIND,XLSDIFFUSION,XROSDIFFUSION,NNBSMOKETRACER,&
+XFLUXZEXT,XFLUXZMAX,XFLXCOEFTMP,&
+LWINDFILTER,CWINDFILTER,XEWAMTAU,XWLIMUTH,XWLIMUTMAX,NWINDSLOPECPLMODE
+!
+END MODULE MODN_FIRE
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index ef08a0077d4ee244a144c6cf400e1545f9c71316..97e763b66f5f836c7032335a4e7c387c25358891 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -237,6 +237,7 @@ END MODULE MODI_PHYS_PARAM_n
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! F. Auguste 02/2021: add IBM
! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
+! A. Costes 12/2021: add Blaze fire model
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1222,8 +1223,8 @@ IF (CSURF=='EXTE') THEN
DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
END IF
- CALL GROUND_PARAM_n(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
+ CALL GROUND_PARAM_n( ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
+ ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
!
IF (LIBM) THEN
WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index 2f781f8e7c208bd4bbc9d2bdc0461fa767033a95..7485c40400d62925d39db8b9d8ee33b2fba9bc5b 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -13,7 +13,7 @@ INTERFACE
OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
ODEPOS_SLT,ODUST,ODEPOS_DST, OCHTRANS, &
- OORILAM,ODEPOS_AER,OLG,OPASPOL, &
+ OORILAM,ODEPOS_AER,OLG,OPASPOL,OFIRE, &
#ifdef MNH_FOREFIRE
OFOREFIRE, &
#endif
@@ -46,6 +46,7 @@ LOGICAL, INTENT(OUT) :: OLG ! lagrangian flag
LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
LOGICAL, INTENT(OUT) :: ODUST ! Dust flag
LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
+LOGICAL, INTENT(OUT) :: OFIRE ! Blaze flag
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(OUT) :: OFOREFIRE! ForeFire flag
#endif
@@ -81,7 +82,7 @@ END MODULE MODI_READ_DESFM_n
OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
ODEPOS_SLT,ODUST,ODEPOS_DST, OCHTRANS, &
- OORILAM,ODEPOS_AER,OLG,OPASPOL, &
+ OORILAM,ODEPOS_AER,OLG,OPASPOL,OFIRE, &
#ifdef MNH_FOREFIRE
OFOREFIRE, &
#endif
@@ -195,6 +196,7 @@ END MODULE MODI_READ_DESFM_n
!! Modification 02/2021 (F.Auguste) add IBM
!! (T.Nagel) add turbulence recycling
!! (E.Jezequel) add stations read from CSV file
+!! Modifications 12/2021 (A. Costes) add Blaze fire model
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -273,6 +275,9 @@ USE MODN_RECYCL_PARAM_n
USE MODN_IBM_PARAM_n
USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
+USE MODD_FIRE
+USE MODN_FIRE
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -313,6 +318,7 @@ CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
+LOGICAL, INTENT(OUT) :: OFIRE ! Blaze flag
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(OUT) :: OFOREFIRE ! ForeFire flag
#endif
@@ -601,6 +607,8 @@ IF (KMI == 1) THEN
CALL POSNAM(ILUDES,'NAM_FOREFIRE',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FOREFIRE)
#endif
+ CALL POSNAM(ILUDES,'NAM_FIRE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FIRE)
CALL POSNAM(ILUDES,'NAM_CONDSAMP',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONDSAMP)
CALL POSNAM(ILUDES,'NAM_BLOWSNOW',GFOUND,ILUOUT)
@@ -644,6 +652,7 @@ OSALT = LSALT
OORILAM = LORILAM
OLG = LLG
OPASPOL = LPASPOL
+OFIRE = LBLAZE
#ifdef MNH_FOREFIRE
OFOREFIRE = LFOREFIRE
#endif
@@ -820,7 +829,13 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT="('************ FOREFIRE ***************')")
WRITE(UNIT=ILUOUT,NML=NAM_FOREFIRE)
!
-#endif
+#endif
+!
+IF (LBLAZE) THEN
+ WRITE(UNIT=ILUOUT,FMT="('******************** BLAZE ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FIRE)
+END IF
+!
WRITE(UNIT=ILUOUT,FMT="('************ CONDITIONAL SAMPLING *************')")
WRITE(UNIT=ILUOUT,NML=NAM_CONDSAMP)
!
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 2d3bddad5cc443b888283d950cf84cbd791326a8..2af45a51df2783a566ca83eee16fbcd0ca1b3884 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -13,7 +13,7 @@ INTERFACE
OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
- OORILAM,ODEPOS_AER, OLG,OPASPOL, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
#ifdef MNH_FOREFIRE
OFOREFIRE, &
#endif
@@ -21,7 +21,7 @@ INTERFACE
OCONDSAMP,OBLOWSNOW, &
KRIMX,KRIMY, KSV_USER, &
HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
- HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+ HEQNSYS,PTSTEP_ALL,HSTORAGE_TYPE,HINIFILEPGD )
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -47,6 +47,7 @@ LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in
LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
#endif
@@ -71,6 +72,7 @@ CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HSTORAGE_TYPE ! type of initial file
CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
!
END SUBROUTINE READ_EXSEG_n
@@ -85,7 +87,7 @@ END MODULE MODI_READ_EXSEG_n
OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
- OORILAM,ODEPOS_AER, OLG,OPASPOL, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
#ifdef MNH_FOREFIRE
OFOREFIRE, &
#endif
@@ -93,7 +95,7 @@ END MODULE MODI_READ_EXSEG_n
OCONDSAMP, OBLOWSNOW, &
KRIMX,KRIMY, KSV_USER, &
HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
- HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+ HEQNSYS,PTSTEP_ALL,HSTORAGE_TYPE,HINIFILEPGD )
! #########################################################################
!
!!**** *READ_EXSEG_n * - routine to read the descriptor file EXSEG
@@ -301,8 +303,8 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
! R. Honnert 23/04/2021: add ADAP mixing length and delete HRIO and BOUT from CMF_UPDRAFT
-! S. Riette 11/05/2021: HighLow cloud
-! P. Wautelet 24/06/2022: remove check on CSTORAGE_TYPE for restart of ForeFire variables
+! S. Riette 11/05/2021 HighLow cloud
+! A. Costes 12/2021: add Blaze fire model
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -313,11 +315,12 @@ USE MODD_CH_AEROSOL
USE MODD_CH_M9_n, ONLY : NEQ
USE MODD_CONDSAMP
USE MODD_CONF
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_CONFZ
! USE MODD_DRAG_n
USE MODD_DUST
USE MODD_DYN
-USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA
+USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA, LHORELAX_SVFIRE
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
@@ -400,7 +403,9 @@ USE MODN_TURB
USE MODN_TURB_CLOUD
USE MODN_TURB_n
USE MODN_VISCOSITY
-
+USE MODD_FIRE
+USE MODN_FIRE
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -429,6 +434,7 @@ LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in
LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
#endif
@@ -453,6 +459,7 @@ CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HSTORAGE_TYPE ! type of initial file
CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
!
!* 0.2 declarations of local variables
@@ -836,6 +843,8 @@ IF (KMI == 1) THEN
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
+ CALL POSNAM(ILUSEG,'NAM_FIRE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIRE)
CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT)
@@ -928,6 +937,14 @@ IF( CCLOUD == 'LIMA' ) THEN
CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_LIMA',CHEVRIMED_ICE_LIMA, &
'GRAU','HAIL')
END IF
+! Blaze
+IF (LBLAZE) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPROPAG_MODEL',CPROPAG_MODEL,'SANTONI2011')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEAT_FLUX_MODEL',CHEAT_FLUX_MODEL,'CST','EXP','EXS')
+ CALL TEST_NAM_VAR(ILUOUT,'CLATENT_FLUX_MODEL',CLATENT_FLUX_MODEL,'CST','EXP')
+ CALL TEST_NAM_VAR(ILUOUT,'CFIRE_CPL_MODE',CFIRE_CPL_MODE,'2WAYCPL','FIR2ATM','ATM2FIR')
+ CALL TEST_NAM_VAR(ILUOUT,'CWINDFILTER',CWINDFILTER,'EWAM','WLIM')
+END IF
IF(LBLOWSNOW) THEN
CALL TEST_NAM_VAR(ILUOUT,'CSNOWSEDIM',CSNOWSEDIM,'NONE','MITC','CARR','TABC')
IF (XALPHA_SNOW .NE. 3 .AND. CSNOWSEDIM=='TABC') THEN
@@ -1768,6 +1785,7 @@ END IF
IF (CCLOUD == 'LIMA') THEN
IF (HCLOUD == 'LIMA') THEN
CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='READ'
+!!JPP IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LIMA &
@@ -2062,6 +2080,9 @@ END IF
IF (LFOREFIRE) THEN
IF (OFOREFIRE) THEN
CGETSVT(NSV_FFBEG:NSV_FFEND)='READ'
+ IF(HSTORAGE_TYPE=='TT') THEN
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT'
+ END IF
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO FOREFIRE SCALAR VARIABLES IN INITIAL FMFILE",/,&
@@ -2070,6 +2091,21 @@ IF (LFOREFIRE) THEN
END IF
END IF
#endif
+! Blaze smoke
+!
+IF (LBLAZE) THEN
+ IF (OFIRE) THEN
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='READ'
+ IF(HSTORAGE_TYPE=='TT') THEN
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='INIT'
+ END IF
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO BLAZE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='INIT'
+ END IF
+END IF
!
! Conditional sampling case
!
@@ -2588,6 +2624,12 @@ IF (.NOT. LFOREFIRE .AND. LHORELAX_SVFF) THEN
WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFF=FALSE'
END IF
#endif
+IF (.NOT. LBLAZE .AND. LHORELAX_SVFIRE) THEN
+ LHORELAX_SVFIRE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLAZE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFIRE=FALSE'
+END IF
IF (.NOT. LCONDSAMP .AND. LHORELAX_SVCS) THEN
LHORELAX_SVCS=.FALSE.
WRITE(UNIT=ILUOUT,FMT=9002) KMI
@@ -2640,7 +2682,7 @@ IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. &
(.NOT. LHORELAX_SVLIMA).AND. &
(.NOT. LHORELAX_SVELEC).AND. (.NOT. LHORELAX_SVCHEM) .AND. &
(.NOT. LHORELAX_SVLG) .AND. (.NOT. LHORELAX_SVPP) .AND. &
- (.NOT. LHORELAX_SVCS) .AND. &
+ (.NOT. LHORELAX_SVCS) .AND. (.NOT. LHORELAX_SVFIRE) .AND. &
#ifdef MNH_FOREFIRE
(.NOT. LHORELAX_SVFF) .AND. &
#endif
@@ -2658,7 +2700,7 @@ IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. &
END IF
!
IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
- LHORELAX_SVCS .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
#ifdef MNH_FOREFIRE
LHORELAX_SVFF .OR. &
#endif
@@ -2684,6 +2726,7 @@ IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHIC=",LHORELAX_SVCHIC
WRITE(ILUOUT,FMT=*) "LHORELAX_SVLG=",LHORELAX_SVLG
WRITE(ILUOUT,FMT=*) "LHORELAX_SVPP=",LHORELAX_SVPP
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFIRE=",LHORELAX_SVFIRE
#ifdef MNH_FOREFIRE
WRITE(ILUOUT,FMT=*) "LHORELAX_SVFF=",LHORELAX_SVFF
#endif
@@ -2705,7 +2748,7 @@ IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
END IF
!
IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
- LHORELAX_SVCS .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
#ifdef MNH_FOREFIRE
LHORELAX_SVFF .OR. &
#endif
@@ -2728,7 +2771,7 @@ IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
END IF
!
IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
- LHORELAX_SVCS .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
#ifdef MNH_FOREFIRE
LHORELAX_SVFF .OR. &
#endif
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index e5a8ff123022926aa6f0ee2853d728df876947fa..32ef01869fd487a49b35919b4b0fb0f881de477a 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -31,7 +31,8 @@ INTERFACE
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
- PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS, &
+ PLSPHI,PBMAP,PFMASE,PFMAWC,PFMWINDU,PFMWINDV,PFMWINDW,PFMHWS )
!
USE MODD_IO, ONLY : TFILEDATA
USE MODD_TIME ! for type DATE_TIME
@@ -126,6 +127,15 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS
!
+! Fire Model fields
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Fire Model Level Set function Phi [-]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Fire Model Burning map [s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Fire Model Available Sensible Energy [J/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Fire Model Available Water Content [kg/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDU ! Fire Model filtered u wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDV ! Fire Model filtered v wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDW ! Fire Model filtered w wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMHWS ! Fire Model filtered horizontal wind speed [m/s]
!
END SUBROUTINE READ_FIELD
!
@@ -156,7 +166,8 @@ END MODULE MODI_READ_FIELD
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
- PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS, &
+ PLSPHI,PBMAP,PFMASE,PFMAWC,PFMWINDU,PFMWINDV,PFMWINDW,PFMHWS )
! ########################################################################
!
!!**** *READ_FIELD* - routine to read prognostic and surface fields
@@ -258,6 +269,7 @@ END MODULE MODI_READ_FIELD
!! F. Auguste 02/2021: add fields necessary for IBM
!! T. Nagel 02/2021: add fields necessary for turbulence recycling
!! J.L. Redelsperger 03/2021: add necessary variables for Ocean LES case
+!! A. Costes 12/2021: add Blaze fire model
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -311,6 +323,8 @@ USE MODE_TOOLS, ONLY: UPCASE
USE MODI_INI_LB
USE MODI_INI_LS
!
+USE MODD_FIRE, ONLY: LBLAZE, LRESTA_ASE, LRESTA_AWC, LWINDFILTER, LRESTA_EWAM, LRESTA_WLIM, CWINDFILTER
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -411,6 +425,15 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Veloc
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary
+! Fire Model fields
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Fire Model Level Set function Phi [-]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Fire Model Burning map [s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Fire Model Available Sensible Energy [J/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Fire Model Available Water Content [kg/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDU ! Fire Model filtered u wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDV ! Fire Model filtered v wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDW ! Fire Model filtered v wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMHWS ! Fire Model filtered horizontal wind speed [m/s]
!
!* 0.2 declarations of local variables
!
@@ -1290,6 +1313,31 @@ IF (NSV_FFEND>=NSV_FFBEG) THEN
END DO
END IF
#endif
+! Blaze smoke variables
+IF (NSV_FIREEND>=NSV_FIREBEG) THEN
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ DO JSV = NSV_FIREBEG,NSV_FIREEND
+ SELECT CASE(HGETSVT(JSV))
+ CASE ('READ')
+ WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
+ IF (IRESP /= 0) THEN
+ PSVT(:,:,:,JSV) = 0.
+ END IF
+ CASE ('INIT')
+ PSVT(:,:,:,JSV) = 0.
+ END SELECT
+ END DO
+END IF
!
IF (NSV_CSEND>=NSV_CSBEG) THEN
TZFIELD%CSTDNAME = ''
@@ -1315,6 +1363,75 @@ IF (NSV_CSEND>=NSV_CSBEG) THEN
END SELECT
END DO
END IF
+! Blaze fire model
+IF (LBLAZE .AND. CCONF=='RESTA') THEN
+ ! Blaze is not compliant with MNHVERSION(1)<5
+ ! Blaze begins with MNH 5.3.1
+ CALL IO_Field_read(TPINIFILE,'LSPHI',PLSPHI,IRESP)
+ IF (IRESP /= 0) PLSPHI = 0.
+ CALL IO_Field_read(TPINIFILE,'BMAP',PBMAP,IRESP)
+ IF (IRESP /= 0) PBMAP = -1.
+ CALL IO_Field_read(TPINIFILE,'FMASE',PFMASE,IRESP)
+ IF(IRESP == 0) THEN
+ ! flag for the use of restart value for ASE initialization
+ LRESTA_ASE = .TRUE.
+ ELSE
+ PFMASE = 0.
+ END IF
+ CALL IO_Field_read(TPINIFILE,'FMAWC',PFMAWC,IRESP)
+ ! flag for the use of restart value for AWC initialization
+ IF(IRESP == 0) THEN
+ LRESTA_AWC = .TRUE.
+ ELSE
+ PFMAWC = 0.
+ END IF
+ ! read wind on fire grid if present
+ IF (LWINDFILTER) THEN
+ ! read in file only if wind filtering is required
+ SELECT CASE(CWINDFILTER)
+ CASE('EWAM')
+ ! read u
+ CALL IO_Field_read(TPINIFILE,'FMWINDU',PFMWINDU,IRESP)
+ ! flag for EWAM filtered u wind
+ IF(IRESP == 0) THEN
+ LRESTA_EWAM = .TRUE.
+ ELSE
+ PFMWINDU = 0.
+ END IF
+ ! read v
+ CALL IO_Field_read(TPINIFILE,'FMWINDV',PFMWINDV,IRESP)
+ ! flag for EWAM filtered v wind
+ IF(IRESP == 0 .AND. LRESTA_EWAM) THEN
+ ! u and v fields found
+ LRESTA_EWAM = .TRUE.
+ ELSE
+ ! u or v fields NOT found
+ LRESTA_EWAM = .FALSE.
+ END IF
+ IF (IRESP /= 0) PFMWINDV = 0.
+ ! read w
+ CALL IO_Field_read(TPINIFILE,'FMWINDW',PFMWINDW,IRESP)
+ ! flag for EWAM filtered w wind
+ IF(IRESP == 0 .AND. LRESTA_EWAM) THEN
+ ! u and v and w fields found
+ LRESTA_EWAM = .TRUE.
+ ELSE
+ ! u or v or w fields NOT found
+ LRESTA_EWAM = .FALSE.
+ END IF
+ IF (IRESP /= 0) PFMWINDW = 0.
+
+ CASE('WLIM')
+ CALL IO_Field_read(TPINIFILE,'FMHWS',PFMHWS,IRESP)
+ ! flag for WLIM filtered horizontal wind speed
+ IF(IRESP == 0) THEN
+ LRESTA_WLIM = .TRUE.
+ ELSE
+ PFMHWS = 0.
+ END IF
+ END SELECT
+ END IF
+END IF
!
IF (NSV_LNOXEND>=NSV_LNOXBEG) THEN
TZFIELD%CSTDNAME = ''
diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90
index 69e130288298efa89da7afaccb9fe70fd88fb11d..1b359718e0af6f176d13733d8d31370295337b6f 100644
--- a/src/MNH/relaxation.f90
+++ b/src/MNH/relaxation.f90
@@ -17,7 +17,7 @@ INTERFACE
OHORELAX_SVELEC,OHORELAX_SVLG, &
OHORELAX_SVCHEM,OHORELAX_SVCHIC, OHORELAX_SVAER, &
OHORELAX_SVDST, OHORELAX_SVSLT, OHORELAX_SVPP, &
- OHORELAX_SVCS,OHORELAX_SVSNW, &
+ OHORELAX_SVCS,OHORELAX_SVSNW, OHORELAX_SVFIRE, &
#ifdef MNH_FOREFIRE
OHORELAX_SVFF, &
#endif
@@ -78,6 +78,8 @@ LOGICAL, INTENT(IN):: OHORELAX_SVSLT ! switch for the
! horizontal relaxation for slt variables
LOGICAL, INTENT(IN):: OHORELAX_SVPP ! switch for the
! horizontal relaxation for passive scalar
+LOGICAL, INTENT(IN):: OHORELAX_SVFIRE ! switch for the
+ ! horizontal relaxation for ForeFire variables
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(IN):: OHORELAX_SVFF ! switch for the
! horizontal relaxation for ForeFire variables
@@ -159,7 +161,7 @@ END MODULE MODI_RELAXATION
OHORELAX_SVELEC,OHORELAX_SVLG, &
OHORELAX_SVCHEM,OHORELAX_SVCHIC, OHORELAX_SVAER, &
OHORELAX_SVDST, OHORELAX_SVSLT, OHORELAX_SVPP, &
- OHORELAX_SVCS,OHORELAX_SVSNW, &
+ OHORELAX_SVCS,OHORELAX_SVSNW, OHORELAX_SVFIRE, &
#ifdef MNH_FOREFIRE
OHORELAX_SVFF, &
#endif
@@ -259,6 +261,7 @@ END MODULE MODI_RELAXATION
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! P. Wautelet 12/02/2021: bugfix: do not call budgets for all SV budgets if LRELAX2FW_ION=T
! P. Wautelet 16/02/2021: bugfix: GMASK3D_RELAX was not computed if OHORELAX_UVWTH=F and needed by other variables
+! A. Costes 12/2021: add Blaze smoke relaxation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -331,6 +334,8 @@ LOGICAL, INTENT(IN):: OHORELAX_SVSLT ! switch for the
! horizontal relaxation for slt variables
LOGICAL, INTENT(IN):: OHORELAX_SVPP ! switch for the
! horizontal relaxation for passive scalar
+LOGICAL, INTENT(IN):: OHORELAX_SVFIRE ! switch for the
+ ! horizontal relaxation for Blaze variables
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(IN):: OHORELAX_SVFF ! switch for the
! horizontal relaxation for ForeFire variables
@@ -430,9 +435,9 @@ LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: GMASK3D_RELAX ! 3D
! mask for hor. relax.
LOGICAL, DIMENSION(7) :: GHORELAXR ! local array of logical
#ifdef MNH_FOREFIRE
-LOGICAL, DIMENSION(13) :: GHORELAXSV! local array of logical
+LOGICAL, DIMENSION(14) :: GHORELAXSV! local array of logical
#else
-LOGICAL, DIMENSION(12) :: GHORELAXSV! local array of logical
+LOGICAL, DIMENSION(13) :: GHORELAXSV! local array of logical
#endif
!
!-------------------------------------------------------------------------------
@@ -493,8 +498,9 @@ GHORELAXSV(9) = OHORELAX_SVPP
GHORELAXSV(10) = OHORELAX_SVCS
GHORELAXSV(11) = OHORELAX_SVCHIC
GHORELAXSV(12) = OHORELAX_SVSNW
+GHORELAXSV(13) = OHORELAX_SVFIRE
#ifdef MNH_FOREFIRE
-GHORELAXSV(13) = OHORELAX_SVFF
+GHORELAXSV(14) = OHORELAX_SVFF
#endif
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/update_nsv.f90 b/src/MNH/update_nsv.f90
index b8e6b36c5063c6b8f83b852a142d51917fede9f4..f75aa19f9aa547e0fd43b47a47e9e75e662b9e68 100644
--- a/src/MNH/update_nsv.f90
+++ b/src/MNH/update_nsv.f90
@@ -137,6 +137,9 @@ NSV_FF = NSV_FF_A(KMI)
NSV_FFBEG = NSV_FFBEG_A(KMI)
NSV_FFEND = NSV_FFEND_A(KMI)
#endif
+NSV_FIRE = NSV_FIRE_A(KMI)
+NSV_FIREBEG = NSV_FIREBEG_A(KMI)
+NSV_FIREEND = NSV_FIREEND_A(KMI)
NSV_CS = NSV_CS_A(KMI)
NSV_CSBEG = NSV_CSBEG_A(KMI)
NSV_CSEND = NSV_CSEND_A(KMI)
diff --git a/src/MNH/write_desfmn.f90 b/src/MNH/write_desfmn.f90
index 8be686e6450155250e7d03c8712d67f659048a94..9aa7454234875a84a7b8d5f5ea767feb10169698 100644
--- a/src/MNH/write_desfmn.f90
+++ b/src/MNH/write_desfmn.f90
@@ -146,12 +146,13 @@ END MODULE MODI_WRITE_DESFM_n
!! Modification V. Vionnet 07/2017 add blowing snow variables
!! Modification F.Auguste 02/2021 add IBM
!! E.Jezequel 02/2021 add stations read from CSV file
+!! Modification A. Costes 12/2021 add Blaze fire model
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
-USE MODD_DYN_n, ONLY: LHORELAX_SVLIMA
+USE MODD_DYN_n, ONLY: LHORELAX_SVLIMA, LHORELAX_SVFIRE
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
@@ -207,6 +208,8 @@ USE MODN_IBM_PARAM_n
USE MODN_RECYCL_PARAM_n
USE MODD_IBM_LSF, ONLY: LIBM_LSF
USE MODN_STATION_n
+USE MODD_FIRE
+USE MODN_FIRE
!
IMPLICIT NONE
!
@@ -224,7 +227,7 @@ LOGICAL :: GHORELAX_UVWTH, &
GHORELAX_RV, GHORELAX_RC, GHORELAX_RR, &
GHORELAX_RI, GHORELAX_RS, GHORELAX_RG, &
GHORELAX_TKE, GHORELAX_SVC2R2, GHORELAX_SVPP, &
- GHORELAX_SVCS, GHORELAX_SVCHIC, &
+ GHORELAX_SVCS, GHORELAX_SVCHIC, GHORELAX_SVFIRE,&
#ifdef MNH_FOREFIRE
GHORELAX_SVFF, &
#endif
@@ -274,7 +277,8 @@ IF (CPROGRAM/='MESONH') THEN ! impose default value for next simulation
GHORELAX_SVCHIC= LHORELAX_SVCHIC
GHORELAX_SVDST = LHORELAX_SVDST
GHORELAX_SVSLT = LHORELAX_SVSLT
- GHORELAX_SVPP = LHORELAX_SVPP
+ GHORELAX_SVPP = LHORELAX_SVPP
+ GHORELAX_SVFIRE = LHORELAX_SVFIRE
#ifdef MNH_FOREFIRE
GHORELAX_SVFF = LHORELAX_SVFF
#endif
@@ -299,6 +303,7 @@ IF (CPROGRAM/='MESONH') THEN ! impose default value for next simulation
LHORELAX_SVCHIC= .FALSE.
LHORELAX_SVLG = .FALSE.
LHORELAX_SVPP = .FALSE.
+ LHORELAX_SVFIRE = .FALSE.
#ifdef MNH_FOREFIRE
LHORELAX_SVFF = .FALSE.
#endif
@@ -398,6 +403,7 @@ IF(LPASPOL) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
#ifdef MNH_FOREFIRE
IF(FFCOUPLING) WRITE(UNIT=ILUSEG,NML=NAM_FOREFIRE)
#endif
+IF(LBLAZE) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
IF(LCONDSAMP) WRITE(UNIT=ILUSEG,NML=NAM_CONDSAMP)
IF(LORILAM.AND.LUSECHEM) WRITE(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
!
@@ -616,6 +622,12 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_FOREFIRE)
!
#endif
+!
+IF (LBLAZE) THEN
+ WRITE(UNIT=ILUOUT,FMT="('******************** BLAZE ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FIRE)
+END IF
+!
WRITE(UNIT=ILUOUT,FMT="('********** CONDSAMP****************************')")
WRITE(UNIT=ILUOUT,NML=NAM_CONDSAMP)
!
@@ -682,6 +694,7 @@ IF (CPROGRAM /='MESONH') THEN !return to previous LHORELAX_
LHORELAX_SVDST = GHORELAX_SVDST
LHORELAX_SVSLT = GHORELAX_SVSLT
LHORELAX_SVPP = GHORELAX_SVPP
+ LHORELAX_SVFIRE = GHORELAX_SVFIRE
#ifdef MNH_FOREFIRE
LHORELAX_SVFF = GHORELAX_SVFF
#endif
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 9a23c67e31a907f7b06f21f93094144f9ce7ebc5..4e11a572ddfe69d8ea56805d977068321fd4efbb 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -180,6 +180,7 @@ END MODULE MODI_WRITE_LFIFM_n
! P. Wautelet 10/03/2021: use scalar variable names for dust and salt
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
! J.L. Redelsperger 03/2021: add OCEAN and auto-coupled O-A LES cases
+! A. Costes 12/2021: add Blaze fire model
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -293,6 +294,8 @@ USE MODD_EOL_ALM
USE MODD_RECYCL_PARAM_n
USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS
USE MODD_IBM_LSF, ONLY: LIBM_LSF
+!
+USE MODD_FIRE
!
IMPLICIT NONE
!
@@ -479,6 +482,25 @@ CALL IO_Field_write(TPFILE,'VT',XVT)
CALL IO_Field_write(TPFILE,'WT',XWT)
!
CALL IO_Field_write(TPFILE,'THT',XTHT)
+IF (LBLAZE) THEN
+ CALL IO_Field_write( TPFILE, 'LSPHI', XLSPHI )
+ CALL IO_Field_write( TPFILE, 'BMAP', XBMAP )
+ CALL IO_Field_write( TPFILE, 'FMR0', XFMR0 )
+ CALL IO_Field_write( TPFILE, 'FIRERW', XFIRERW )
+ CALL IO_Field_write( TPFILE, 'FMASE', XFMASE )
+ CALL IO_Field_write( TPFILE, 'FMAWC', XFMAWC )
+ CALL IO_Field_write( TPFILE, 'FMFLUXHDH', XFMFLUXHDH )
+ CALL IO_Field_write( TPFILE, 'FMFLUXHDW', XFMFLUXHDW )
+ IF (LWINDFILTER .AND. CWINDFILTER=='WLIM') THEN
+ CALL IO_Field_write( TPFILE, 'FMHWS', XFMHWS )
+ ELSE
+ CALL IO_Field_write( TPFILE, 'FMWINDU', XFMWINDU )
+ CALL IO_Field_write( TPFILE, 'FMWINDV', XFMWINDV )
+ CALL IO_Field_write( TPFILE, 'FMWINDW', XFMWINDW )
+ END IF
+ CALL IO_Field_write( TPFILE, 'FMGRADOROX', XFMGRADOROX )
+ CALL IO_Field_write( TPFILE, 'FMGRADOROY', XFMGRADOROY )
+END IF
!
!* 1.4.2 Time t-dt:
!
@@ -1209,6 +1231,24 @@ IF (NSV >=1) THEN
END DO
END IF
#endif
+! Blaze scalar variables
+IF ( LBLAZE ) THEN
+ TZFIELD%CSTDNAME = 'fire smoke'
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ DO JSV = NSV_FIREBEG,NSV_FIREEND
+ WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ JSA=JSA+1
+ END DO
+END IF
! Blowing snow variables
IF (LBLOWSNOW) THEN
TZFIELD%CSTDNAME = ''