Skip to content

Commit

Permalink
line ignition with coordinates from namelist
Browse files Browse the repository at this point in the history
  • Loading branch information
Jan Mandel authored and Jan Mandel committed Dec 14, 2007
1 parent 569eb57 commit 2439f24
Show file tree
Hide file tree
Showing 10 changed files with 256 additions and 126 deletions.
2 changes: 2 additions & 0 deletions wrfv2_fire/Registry/Registry.EM
Expand Up @@ -1447,10 +1447,12 @@ state integer ischap *i*j fire 1 z hr "ISCHAP"
#
#<Table> <Type> <Sym> <How set> <Nentries> <Default>
rconfig integer ifire namelist,fire 1 0
rconfig integer fire_num_ignitions namelist,fire 1 0. - "fire_num_ignitions" "number of ignition lines"
rconfig real fire_ignition_start_x namelist,fire 1 0. - "fire_ignition_start_x" "x coord of start of ignition line" "m"
rconfig real fire_ignition_start_y namelist,fire 1 0. - "fire_ignition_start_y" "y coord of start of ignition line" "m"
rconfig real fire_ignition_end_x namelist,fire 1 0. - "fire_ignition_end_x" "x coord of end of ignition line" "m"
rconfig real fire_ignition_end_y namelist,fire 1 0. - "fire_ignition_end_y" "y coord of end of ignition line" "m"
rconfig real fire_ignition_radius namelist,fire 1 0. - "fire_ignition_radius" "ignite all within the radius" "m"
rconfig real fire_ignition_time namelist,fire 1 0. - "fire_ignition_time" "ignition time" "s"
rconfig real fire_lat_init namelist,fire 1 0. - "fire_lat_init" "latitude to start fire" "degrees"
rconfig real fire_lon_init namelist,fire 1 0. - "fire_lon_init" "longitude to start fire" "degrees"
Expand Down
2 changes: 1 addition & 1 deletion wrfv2_fire/configure.wrf.backup
Expand Up @@ -81,7 +81,7 @@ ESMF_TARGET = esmf_time
#
OMP =
OMPCPP =
FC = ifort -g -debug extended -debug-parameters all -traceback
FC = ifort -g -debug extended -debug-parameters all -traceback -fpe0
CC = gcc -DFSEEKO64_OK
SCC = $(CC)
SFC = $(FC)
Expand Down
6 changes: 5 additions & 1 deletion wrfv2_fire/dyn_em/solve_em.F
Expand Up @@ -780,6 +780,11 @@ SUBROUTINE solve_em ( grid , config_flags &
,model_config_rec%s_we(1), model_config_rec%e_we(1) &
,model_config_rec%s_sn(1), model_config_rec%e_sn(1) &
,grid%sr_x,grid%sr_y &
,config_flags%fire_num_ignitions & ! start ignition for SFIRE
,config_flags%fire_ignition_start_x,config_flags%fire_ignition_start_y & ! ignition - small arrays
,config_flags%fire_ignition_end_x,config_flags%fire_ignition_end_y &
,config_flags%fire_ignition_radius &
,config_flags%fire_ignition_time & ! end ignitin for SFIRE
,config_flags%fire_lat_init,config_flags%fire_lon_init &
,config_flags%fire_ign_time &
,config_flags%fire_shape,config_flags%fire_crwn_hgt &
Expand Down Expand Up @@ -3513,4 +3518,3 @@ SUBROUTINE solve_em ( grid , config_flags &
RETURN
END SUBROUTINE solve_em
30 changes: 24 additions & 6 deletions wrfv2_fire/phys/model_test_main.F
Expand Up @@ -28,12 +28,15 @@ subroutine model_test( &
real, dimension(ifms:ifme,jfms:jfme):: zsf, &
lfn,tign,fuel_frac, &
grnhfx,grnqfx
integer:: initialize, ignition,i,j,ifuelread,istep,nfuel_cat0
integer:: initialize, num_ignitions,i,j,ifuelread,istep,nfuel_cat0
real:: t0,time_start,sm,sn
integer, dimension(ifms:ifme,jfms:jfme)::nfuel_cat,ischap
real, dimension(ifms:ifme,jfms:jfme)::fuel_time,vx,vy,dzfsdx,dzfsdy,bbb,betafl,phiwc,r_0,fgip
integer::num_tiles
integer, dimension(100)::i_start,i_end,j_start,j_end
integer, parameter :: max_ignitions=1
real, dimension(max_ignitions) :: ignition_start_x,ignition_start_y, &
ignition_end_x,ignition_end_y,ignition_radius,ignition_time

!*** executable

Expand Down Expand Up @@ -69,23 +72,38 @@ subroutine model_test( &
do istep=1,msteps
if(istep.eq.1)then
initialize=1
ignition=0
num_ignitions=0
elseif(istep.eq.2)then
initialize=0
ignition=1
num_ignitions=1
ignition_start_x(1)=0.5*fdx*(ifde-ifds)
ignition_start_y(1)=0.5*fdy*(jfde-jfds)
ignition_end_x(1)=0.5*fdx*(ifde-ifds)*0.9999999
ignition_end_y(1)=0.5*fdy*(jfde-jfds)*1.0000001
ignition_start_x(1)=1000
ignition_start_y(1)=500
ignition_end_x(1)=1000
ignition_end_y(1)=1500
! at least 6 by 6 cells but no less than 5 m
ignition_radius(1) = 0.5*max(5.0,6*max(fdx,fdy))
ignition_time(1)=time_start
else
initialize=0
ignition=0
num_ignitions=0
endif
call sfire_model ( &
initialize, ignition, & ! switches
initialize, num_ignitions, &
ifuelread,nfuel_cat0, &
ifds,ifde,jfds,jfde, & ! fire domain dims - the whole domain
ifms,ifme,jfms,jfme, & ! fire memory dims - how declared
ifps,ifpe,jfps,jfpe, & ! fire patch dims - this processor
num_tiles,i_start,i_end,j_start,j_end, & ! fire grid tiling - divide for openmp
time_start,dt, & ! time and increment
fdx,fdy, & ! fire mesh spacing
ignition_start_x,ignition_start_y, &
ignition_end_x,ignition_end_y, &
ignition_radius, &
ignition_time, &
zsf, & ! terrain height (for gradient)
vx,vy, & ! input: wind
lfn,tign,fuel_frac, & ! state: level function, ign time, fuel left
Expand All @@ -94,7 +112,7 @@ subroutine model_test( &
fuel_time, & ! save derived internal data
dzfsdx,dzfsdy,bbb,betafl,phiwc,r_0,fgip,ischap &
)
if(mod(istep,50).eq.0)then
if(istep.le.10.or.mod(istep,50).eq.0)then
write(1,1)1.,1.,time_start
write(1,1)sm+1,sn+1,((lfn(i,j),i=ifps,ifpe+1),j=jfps,jfpe+1)
write(1,1)sm+1,sn+1,((tign(i,j),i=ifps,ifpe+1),j=jfps,jfpe+1)
Expand Down
19 changes: 18 additions & 1 deletion wrfv2_fire/phys/module_fire_driver.F
Expand Up @@ -21,6 +21,11 @@ SUBROUTINE fire_driver(ifire &
,moad_lat_ll,moad_lon_ll,moad_dx,moad_dy &
,moad_s_we,moad_e_we,moad_s_sn,moad_e_sn &
,sr_x,sr_y &
,fire_num_ignitions &
,fire_ignition_start_x,fire_ignition_start_y & ! ignition - small arrays
,fire_ignition_end_x,fire_ignition_end_y &
,fire_ignition_radius &
,fire_ignition_time &
,fire_lat_init,fire_lon_init,fire_ign_time &
,fire_shape,fire_crwn_hgt &
,fire_ext_grnd,fire_ext_crwn,fire_sprd_mdl &
Expand Down Expand Up @@ -187,10 +192,17 @@ SUBROUTINE fire_driver(ifire &
lfn,fuel_frac,fuel_time,dzfsdx,dzfsdy,fgip
INTEGER,intent(inout),DIMENSION( ifms:ifme,jfms:jfme ) :: ischap

! ignition variables for SFIRE
integer, intent(in):: fire_num_ignitions ! number of ignitions, can be 0
real, dimension(fire_num_ignitions), intent(in):: &
fire_ignition_start_x,fire_ignition_start_y, &
fire_ignition_end_x,fire_ignition_end_y,fire_ignition_radius, & ! start, end, radius, time
fire_ignition_time ! of ignition lines


! ---- local variables

INTEGER :: i,j,k,nk,jj,ij,its,ite,jts,jte
INTEGER :: i,j,k,nk,jj,ij,its,ite,jts,jte, num_ignitions

REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: v_tmp
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: u_tmp
Expand Down Expand Up @@ -288,6 +300,11 @@ SUBROUTINE fire_driver(ifire &
,dt,dx,dy &
,u_frame,v_frame &
,fire_ext_grnd,fire_ext_crwn,fire_crwn_hgt &
,fire_num_ignitions &
,fire_ignition_start_x,fire_ignition_start_y & ! ignition - small arrays
,fire_ignition_end_x,fire_ignition_end_y &
,fire_ignition_radius &
,fire_ignition_time &
,u,v,mu,rho,ht &
,z_at_w,dz8w &
,lfn,tign_c,fuel_frac &
Expand Down
141 changes: 141 additions & 0 deletions wrfv2_fire/phys/module_fr_sfire_core.F
Expand Up @@ -180,10 +180,151 @@ subroutine sfire_core( ids,ide,jds,jde, &
enddo

end subroutine sfire_core

!
!****************************************
!

subroutine init_no_fire (ifds,ifde,jfds,jfde, & ! dimensions
ifts,ifte,jfts,jfte, &
ifms,ifme,jfms,jfme, &
fdx,fdy,time_now, & ! scalars in
fuel_frac,lfn,tign) ! arrays out
implicit none

!*** purpose: initialize model to no fire

!*** arguments
integer, intent(in):: ifds,ifde,jfds,jfde ! fire domain bounds
integer, intent(in):: ifts,ifte,jfts,jfte ! fire tile bounds
integer, intent(in):: ifms,ifme,jfms,jfme ! array bounds
real, intent(in) :: fdx,fdy,time_now ! mesh spacing, time
real, intent(out), dimension (ifms:ifme,jfms:jfme) :: &
fuel_frac,lfn,tign ! model state

!*** calls
intrinsic epsilon

!*** local
integer:: i,j
real lfn_init,time_init


do j=jfts,jfte
do i=ifts,ifte
fuel_frac(i,j)=1. ! fuel at start is 1 by definition
enddo
enddo

lfn_init = 2*max((ifde-ifds+1)*fdx,(jfde-jfds+1)*fdy) ! more than domain diameter
time_init=time_now + max(time_now,1.0)*epsilon(time_now) ! a bit in future

do j=jfts,jfte+1
do i=ifts,ifte+1
tign(i,j) = time_init ! ignition in future
lfn(i,j) = lfn_init ! no fire
enddo
enddo
call message('init_model_no_fire: state set to no fire')

end subroutine init_no_fire

!
!******************
!


subroutine ignite_fire( ifds,ifde,jfds,jfde, & ! fire domain dims - the whole domain
ifts,ifte,jfts,jfte, &
ifms,ifme,jfms,jfme, &
sx,sy,ex,ey,r,time_ign,fdx,fdy, &
lfn,tign,ignited)
implicit none

!*** purpose: ignite a circular fire

!*** arguments
integer, intent(in):: ifds,ifde,jfds,jfde ! fire domain bounds
integer, intent(in):: ifts,ifte,jfts,jfte ! fire tile bounds
integer, intent(in):: ifms,ifme,jfms,jfme ! array bounds
real, intent(in):: time_ign ! the ignition time of the fire
real, intent(in):: sx,sy ! start of ignition line, from lower left corner
real, intent(in):: ex,ey ! end of ignition line, or zero
real, intent(in):: r ! all within the radius of the line will ignite
real, intent(in):: fdx,fdy ! mesh spacing (m)
real, intent(inout), dimension (ifms:ifme,jfms:jfme) :: &
lfn, tign ! level function, ignition time (state)
integer, intent(out):: ignited ! number of nodes newly ignited

!*** local
integer:: i,j
real::mx,my,ax,ay,dam2,d,dames,des2,am_es,cos2,lfn_new,dmc2
logical::point
character(len=128):: msg

ignited=0
point = ex .eq. 0.0 .or. ey .eq. 0.0
if (.not.point)then
! midpoint m = (mx,my)
mx = (sx + ex)/2
my = (sy + ey)/2
else
mx = sx
my = sy
endif
do j=jfts,jfte+1 ! node based loops, hence the +1
do i=ifts,ifte+1
! coordinates of the point a=(ax ay), the lower left corner of the domain is (0 0)
ax = fdx*(i - ifds)
ay = fdy*(j - jfds)
dam2=(ax-mx)*(ax-mx)+(ay-my)*(ay-my) ! |a-m|^2
if(point)then
d=sqrt(dam2)
else
! compute distance as distance from midpoint minus correction
! |a-c|^2 = |a-m|^2 - |m-c|^2
! when |m-c| >= |s-e|/2 use distance from the endpoint instead
!
! a
! /| \
! s---m-c--e
!
! |m-c| = |a-m| cos (a-m,e-s)
! = |a-m| (a-m).(e-s))/(|a-m|*|e-s|)
des2 = (ex-sx)*(ex-sx)+(ey-sy)*(ey-sy) ! |e-s|^2
dames = dam2*des2
if(dames>0)then
am_es=(ax-mx)*(ex-sx)+(ay-my)*(ey-sy) ! (a-m).(e-s)
cos2 = (am_es*am_es)/dames ! cos^2 (a-m,e-s)
else
cos2 = 0.
endif
dmc2 = dam2*cos2 ! |m-c|^2
if(4.*dmc2 <= des2)then
d = sqrt(max(dam2 - dmc2,0.)) ! just in case, rounding
elseif(am_es>0)then ! cos > 0, closest is e
d = sqrt((ax-ex)*(ax-ex)+(ay-ey)*(ay-ey)) ! |a-e|
else
d = sqrt((ax-sx)*(ax-sx)+(ay-sy)*(ay-sy)) ! |a-s|
endif
endif
lfn_new=d-r
if(lfn(i,j)>0 .and. lfn_new<=0) then
tign(i,j)=time_ign ! newly ignited now
ignited=ignited+1 ! count
endif
lfn(i,j)=min(lfn(i,j),lfn_new) ! update the level set function
enddo
enddo
write(msg,'(a,2f10.1,a,2f10.1,a,f8.1,a,f8.1,a,i3)')'ignite_fire: from',sx,sy,' to ',&
ex,ey,' radius ',r,' time',time_ign,' ignited nodes',ignited
call message(msg)
end subroutine ignite_fire

!
!**********************
!

subroutine fuel_left_jm(ids,ide,jds,jde, &
ims,ime,jms,jme, &
lfn, tign, fuel_time, tnow, fuel_frac)
Expand Down
21 changes: 17 additions & 4 deletions wrfv2_fire/phys/module_fr_sfire_driver.F
Expand Up @@ -68,6 +68,11 @@ subroutine sfire_driver ( &
itimestep,ifuelread,nfuel_cat0,dt,dx,dy, & ! in scalars
u_frame,v_frame, &
alfg,alfc,z1can, &
num_ignitions, &
ignition_start_x,ignition_start_y, & ! ignition - small arrays
ignition_end_x,ignition_end_y, &
ignition_radius, &
ignition_time, &
u,v,mu,rho,zs, & ! in arrays, atm grid
z_at_w,dz8w, &
lfn,tign,fuel_frac, & ! state arrays, fire grid
Expand Down Expand Up @@ -109,6 +114,12 @@ subroutine sfire_driver ( &
alfg, & ! extinction depth of ground fire heat (m)
alfc ! extinction depth of crown fire heat (m)

integer, intent(in):: num_ignitions ! number of ignitions, can be 0
real, dimension(num_ignitions), intent(in):: &
ignition_start_x,ignition_start_y, &
ignition_end_x,ignition_end_y,ignition_radius, & ! start, end, radius, time
ignition_time ! of ignition lines

real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::u,v ! wind velocity (m/s) (node based, atm grid)
real,intent(in),dimension(ims:ime,jms:jme)::mu ! dry air mass (Pa) pressure?? (cell based, atm grid)
real,intent(in),dimension(ims:ime, kms:kme, jms:jme)::rho ! air density (kg/m^3) (cell based, atm grid)
Expand Down Expand Up @@ -145,7 +156,7 @@ subroutine sfire_driver ( &
integer,dimension(num_tiles) :: if_start,if_end,jf_start,jf_end, & ! fire grid tiling
ia_start,ia_end,ja_start,ja_end ! atm grid tiling
integer :: its,ite,jts,jte,kts,kte, &
ij,i,j,k,initialize,ignition, &
ij,i,j,k,initialize, &
ifts,ifte,jfts,jfte,ifte1,jfte1, & ! fire tile
ifps, ifpe, jfps, jfpe, & ! fixed fire patch bounds
iaps, iape, japs, jape ! fixed atm patch bounds
Expand All @@ -160,10 +171,8 @@ subroutine sfire_driver ( &
! and set to 1 at the right time by the caller
if(itimestep .eq. 1 )then
initialize=1
ignition=1
else
initialize=0
ignition=0
endif
! time - assume dt does not change
Expand Down Expand Up @@ -400,14 +409,18 @@ subroutine sfire_driver ( &
! the model is parallel itself, call on the whole patch not just a tile
call sfire_model ( &
initialize, ignition, & ! switches
initialize, num_ignitions, & ! switches
ifuelread,nfuel_cat0, & ! initialize fuel categories
ifds,ifde,jfds,jfde, & ! fire domain dims
ifms,ifme,jfms,jfme, & ! fire memory dims
ifps,ifpe,jfps,jfpe, & ! fire patch dims
num_tiles,if_start,if_end,jf_start,jf_end, & ! fire grid tiling
time_start,dt, & ! time and increment
dxf,dyf, & ! fire mesh spacing
ignition_start_x,ignition_start_y, & ! ignition - small arrays
ignition_end_x,ignition_end_y, &
ignition_radius, &
ignition_time, &
zsf, & ! terrain height (for gradient)
uf,vf, & ! input: wind
lfn,tign,fuel_frac, & ! state: level function, ign time, fuel left
Expand Down

0 comments on commit 2439f24

Please sign in to comment.