| blob | 5111971a8450204cdd35e2b41567a4f49540900a |
1 ! WRF:MEDIATION_LAYER:FIRE_MODEL
3 !*** Jan Mandel August 2007 - February 2008
4 !*** email: jmandel@ucar.edu or Jan.Mandel@gmail.com or Jan.Mandel@cudenver.edu
6 ! For support please subscribe to the wrf-fire mailing list at NCAR at
7 ! http://mailman.ucar.edu/mailman/listinfo/wrf-fire
8 !
9 ! ALL RESPONSES TO INQUIRIES ABOUT THIS CODE WILL BE COPIED TO THE wrf-fire LIST
11 ! This module is the only entry point from WRF-ARW to the wildland
12 ! fire model. The call to sfire_driver advances the fire model by
13 ! one timestep. The fire model inputs the wind and outputs
14 ! temperature and humidity tendencies. The fire model also inputs a
15 ! number of constant arrays (fuel data, topography). Additional
16 ! arguments are model state (for data assimilation) and constant arrays
17 ! the model gives to WRF for safekeeping because it is not allowed
18 ! to save anything.
20 ! This model is described in [1]. The fire model is coupled with WRF
21 ! but the fire code itself is not dependent on WRF in any way other
22 ! than calls to few WRF utilities from module_fr_sfire_util. This
23 ! model uses a level set function method for advancing the fireline.
24 ! It is a reimplementation of an earlier model, which used fireline
25 ! propagation by tracers and was coupled with the Clark-Hall
26 ! atmospheric code, described in [2]. For WRF documentation see [3].
28 ! Acknowledgements: Contributions to the level set method by Mijeong
29 ! Kim. The fire physics is adapted from an earlier code by Terry
30 ! L. Clark, Janice L. Coen, and Don Latham. The coupling with WRF is
31 ! adapted from a code by Ned Patton for coupling of the earlier fire
32 ! model with WRF, with contributions by Jonathan D. Beezley. The
33 ! WRF build and execution environment was set up by Jonathan Beezley.
35 ! [1] Jan Mandel, Jonathan D. Beezley, Janice L. Coen, and Minjeong Kim,
36 ! Data Asimilation for Wildland Fires: Ensemble Kalman filters in
37 ! coupled atmosphere-surface models, IEEE Control Systems Magazine,
38 ! submitted, 2007
40 ! [2] T. L. Clark, J. Coen, and D. Latham, Description of a coupled
41 ! atmosphere-fire model, Intl. J. Wildland Fire, vol. 13, pp. 49-64,
42 ! 2004
43 !
44 ! [3] http://www.mmm.ucar.edu/wrf/OnLineTutorial/Introduction/index.html
46 #define DEBUG_OUT
48 module module_fr_sfire_driver
50 use module_model_constants, only: cp,xlv
51 use module_fr_sfire_model
52 use module_fr_sfire_phys
53 use module_fr_sfire_atm
54 use module_fr_sfire_util
56 contains
59 subroutine sfire_driver_em ( grid , config_flags &
60 ,ids,ide, kds,kde, jds,jde &
61 ,ims,ime, kms,kme, jms,jme &
62 ,ips,ipe, kps,kpe, jps,jpe &
63 ,ifds,ifde, jfds,jfde &
64 ,ifms,ifme, jfms,jfme &
65 ,ifps,ifpe, jfps,jfpe &
66 ,rho,z_at_w,dz8w &
67 )
68 !*** purpose: driver from grid structure
70 ! Driver layer modules
71 USE module_domain
72 USE module_configure
73 USE module_driver_constants
74 USE module_machine
75 USE module_tiles
76 USE module_dm
78 implicit none
79 !*** arguments
80 TYPE(domain) , TARGET :: grid ! data
81 ! Structure that contains run-time configuration (namelist) data for domain
82 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
83 integer, intent(in):: &
84 ids,ide, kds,kde, jds,jde &
85 ,ims,ime, kms,kme, jms,jme &
86 ,ips,ipe, kps,kpe, jps,jpe &
87 ,ifds,ifde, jfds,jfde &
88 ,ifms,ifme, jfms,jfme &
89 ,ifps,ifpe, jfps,jfpe
90 real,intent(in),dimension(ims:ime, kms:kme, jms:jme)::rho, &! air density (kg/m^3) (cell based, atm grid)
91 z_at_w,dz8w ! ????????
93 !*** local
94 INTEGER:: fire_num_ignitions
95 integer, parameter::fire_max_ignitions=5
96 REAL, DIMENSION(fire_max_ignitions):: fire_ignition_start_x, &
97 fire_ignition_start_y, &
98 fire_ignition_end_x, &
99 fire_ignition_end_y, &
100 fire_ignition_time, &
101 fire_ignition_radius
102 integer::fire_ifun,fire_ifun_start,ir,jr,fire_ignition_longlat,istep,itimestep
103 logical::need_lfn_update
104 !real, dimension(ifms:ifme, jfms:jfme)::uf,vf,lfn_out
105 ! uf vf only do not need to be in the state but we need halo on them
106 real, dimension(ifms:ifme, jfms:jfme)::lfn_out
107 integer, dimension(ifms:ifme, jfms:jfme)::nfuel_cat_int
108 real::lat_ctr,lon_ctr
110 !*** executable
112 call print_id
115 ! populate our structures from wrf
116 call fire_ignition_convert (config_flags,fire_max_ignitions,fire_ignition_longlat, &
117 fire_ignition_start_x,fire_ignition_start_y,fire_ignition_end_x,fire_ignition_end_y, &
118 fire_ignition_radius,fire_ignition_time,fire_num_ignitions)
119 call set_flags(config_flags)
121 ir=grid%sr_x ! refinement ratio
122 jr=grid%sr_y
123 itimestep=grid%itimestep
125 lat_ctr=config_flags%cen_lat
126 lon_ctr=config_flags%cen_lon
128 do istep=0,fire_test_steps ! istep >0 is for testing only, exit after the first call
129 itimestep = itimestep + istep ! in the first call, do fire_test_steps steps of the fire model
131 fire_ifun_start=1 ! initialize?
132 if(itimestep.ne.1)fire_ifun_start=3 ! should find a better distinction when to initialize
134 need_lfn_update=.false.
135 do fire_ifun=fire_ifun_start,6
137 ! 1 = initialize run pass 1: interpolate height to zsf=terrain
138 ! 2 = initialize run pass 2: set fuel data, terrain gradient
139 ! 3 = initialize timestep: interpolate winds, check for ignition
140 ! 4 = do one timestep
141 ! 5 = copy timestep output to input
142 ! 6 = compute output fluxes
144 #ifdef DM_PARALLEL
145 if(need_lfn_update)then
146 ! halo exchange on lfn width 2
147 #include "HALO_FIRE_LFN.inc"
148 endif
150 if(fire_ifun.eq.1)then
151 ! halo exchange on topography
152 #include "HALO_FIRE_LONGLAT.inc"
153 if(fire_topo_from_atm.eq.1)then
154 #include "HALO_FIRE_HT.inc"
155 endif
157 elseif(fire_ifun.eq.2)then
158 ! halo exchange on zsf width 2
159 #include "HALO_FIRE_ZSF.inc"
161 elseif(fire_ifun.eq.3)then
162 if(fire_ifun_start<3)then
163 ! halo exchange on all fuel data width 2
164 #include "HALO_FIRE_FUEL.inc"
165 endif
166 ! halo exchange on atm winds width 1 for interpolation
167 #include "HALO_FIRE_WIND_A.inc"
169 elseif(fire_ifun.eq.4)then
170 ! halo exchange on fire winds width 2 for a 2-step RK method
171 #include "HALO_FIRE_WIND_F.inc"
173 elseif(fire_ifun.eq.6)then
174 ! computing fuel_left needs ignition time from neighbors
175 #include "HALO_FIRE_TIGN.inc"
177 endif
178 #endif
179 nfuel_cat_int(:,:)=int(grid%nfuel_cat)
180 ! need domain by 1 smaller, in last row.col winds are not set properly
181 call sfire_driver_phys ( &
182 fire_ifun,need_lfn_update, &
183 ids,ide-1, kds,kde, jds,jde-1, &
184 ims,ime, kms,kme, jms,jme, &
185 ips,min(ipe,ide-1), kps,kpe, jps,min(jpe,jde-1), &
186 ifds,ifde-ir, jfds,jfde-jr, &
187 ifms,ifme, jfms,jfme, &
188 ifps,min(ifpe,ifde-ir), jfps,min(jfpe,jfde-jr), &
189 ir,jr, & ! atm/fire grid ratio
190 grid%num_tiles, & ! atm grid tiling
191 grid%i_start,min(grid%i_end,ide-1), &
192 grid%j_start,min(grid%j_end,jde-1), &
193 itimestep,config_flags%fire_fuel_read,config_flags%fire_fuel_cat, & ! in scalars
194 grid%dt,grid%dx,grid%dy, &
195 grid%u_frame,grid%v_frame, &
196 lat_ctr,lon_ctr, & ! coordinates of grid center
197 config_flags%fire_ext_grnd,config_flags%fire_ext_crwn,config_flags%fire_crwn_hgt, &
198 fire_num_ignitions, &
199 fire_ignition_longlat, &
200 fire_ignition_start_x,fire_ignition_start_y, & ! ignition - small arrays
201 fire_ignition_end_x,fire_ignition_end_y, &
202 fire_ignition_radius,fire_ignition_time, &
203 grid%u_2,grid%v_2,grid%mut,rho,grid%ht, & ! in arrays, on atm grid
204 z_at_w,dz8w, &
205 grid%xlong,grid%xlat, & ! coordinates of atm grid centers, for ignition location
206 grid%lfn,grid%tign_g,grid%fuel_frac, & ! state arrays, fire grid
207 grid%fire_area, & ! redundant, for display, fire grid
208 grid%uf,grid%vf,lfn_out, & ! arrays to persist only over one timestep
209 grid%rthfrten,grid%rqvfrten, & ! out arrays, atm grid
210 grid%grnhfx,grid%grnqfx,grid%canhfx,grid%canqfx, & ! out redundant arrays, atm grid
211 grid%fgrnhfx,grid%fgrnqfx,grid%fcanhfx,grid%fcanqfx, & ! out redundant arrays, atm grid
212 grid%fxlong,grid%fxlat, &
213 nfuel_cat_int, & ! input, or internal for safekeeping
214 grid%fuel_time,grid%zsf, &
215 grid%bbb,grid%betafl,grid%phiwc,grid%r_0,grid%fgip,grid%ischap&
216 )
217 grid%nfuel_cat(:,:)=real(nfuel_cat_int(:,:))
218 enddo
219 enddo
220 if(fire_test_steps>0)call crash('sfire_driver_em: test run of uncoupled fire model completed')
222 end subroutine sfire_driver_em
224 !
225 !*******************
226 !
228 ! module_fr_sfire_driver%%sfire_driver
229 subroutine sfire_driver_phys (ifun,need_lfn_update, &
230 ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
231 ims,ime, kms,kme, jms,jme, &
232 ips,ipe, kps,kpe, jps,jpe, &
233 ifds, ifde, jfds, jfde, & ! fire grid dimensions
234 ifms, ifme, jfms, jfme, &
235 ifps, ifpe, jfps, jfpe, & ! fire patch in - will use smaller
236 ir,jr, & ! atm/fire grid ratio
237 num_tiles,i_start,i_end,j_start,j_end, & ! atm grid tiling
238 itimestep,ifuelread,nfuel_cat0,dt,dx,dy, & ! in scalars
239 u_frame,v_frame, &
240 lat_ctr,lon_ctr, &
241 fire_ext_grnd,fire_ext_crwn,fire_crwn_hgt, &
242 num_ignitions, &
243 ignition_longlat, &
244 ignition_start_x,ignition_start_y, & ! ignition - small arrays
245 ignition_end_x,ignition_end_y, &
246 ignition_radius, &
247 ignition_time, &
248 u,v,mu,rho,zs, & ! in arrays, atm grid
249 z_at_w,dz8w, &
250 xlong,xlat, &
251 lfn,tign,fuel_frac, & ! state arrays, fire grid
252 fire_area, & ! redundant state, fire grid
253 uf,vf,lfn_out, & ! fire wind velocities, out level set function
254 rthfrten,rqvfrten, & ! out arrays, atm grid
255 grnhfx,grnqfx,canhfx,canqfx, & ! out redundant arrays, atm grid
256 fgrnhfx,fgrnqfx,fcanhfx,fcanqfx, & ! out redundant arrays, fire grid
257 fxlong,fxlat, & !
258 nfuel_cat, & ! in array, data, fire grid, or constant internal
259 fuel_time,zsf, & ! save constant internal data, fire grid
260 bbb,betafl,phiwc,r_0,fgip,ischap&
261 )
263 implicit none
265 !*** arguments
267 integer, intent(in)::ifun, &
268 ids,ide, kds,kde, jds,jde, & ! atm domain bounds
269 ims,ime, kms,kme, jms,jme, & ! atm memory bounds
270 ips,ipe, kps,kpe, jps,jpe, & ! atm patch bounds
271 ifds, ifde, jfds, jfde, & ! fire domain bounds
272 ifms, ifme, jfms, jfme, & ! fire memory bounds
273 ifps, ifpe, jfps, jfpe, & ! fire patch bounds
274 ir,jr, & ! atm/fire grid refinement ratio
275 itimestep, & ! number of this timestep
276 ifuelread, & ! how to initialize nfuel_cat:
277 ! -1=not at all, done outside
278 ! 0=from nfuel_cat0
279 ! 1=from altitude
280 ! 2=from file
281 nfuel_cat0, & ! fuel category to initialize everything to
282 num_tiles ! number of tiles
285 logical, intent(out)::need_lfn_update
287 integer,dimension(num_tiles),intent(in) :: i_start,i_end,j_start,j_end ! atm grid tiling
289 real, intent(in):: &
290 dt, & ! time step
291 dx,dy, & ! atm grid step
292 u_frame,v_frame, & ! velocity offset
293 lat_ctr,lon_ctr, & ! coordinates of domain center
294 fire_crwn_hgt, & ! lowest height crown fire heat is released (m)
295 fire_ext_grnd, & ! extinction depth of ground fire heat (m)
296 fire_ext_crwn ! extinction depth of crown fire heat (m)
299 integer, intent(in):: num_ignitions ! number of ignitions, can be 0
300 real, dimension(num_ignitions), intent(in):: &
301 ignition_start_x,ignition_start_y, &
302 ignition_end_x,ignition_end_y,ignition_radius, & ! start, end, radius, time
303 ignition_time ! of ignition lines
304 integer, intent(in):: ignition_longlat ! if 1 ignition give as long/lat, otherwise as m from lower left corner
306 real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::u,v ! wind velocity (m/s) (node based, atm grid)
307 real,intent(in),dimension(ims:ime,jms:jme)::mu ! dry air mass (Pa) pressure?? (cell based, atm grid)
308 real,intent(in),dimension(ims:ime, jms:jme):: zs ! terrain height
309 real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::rho, & ! air density (kg/m^3) (cell based, atm grid)
310 z_at_w,dz8w ! height of some sort??
312 real, dimension(ims:ime, jms:jme), intent(inout)::xlong, xlat ! inout because of extension at bdry
314 integer, intent(inout), dimension(ifms:ifme,jfms:jfme):: &
315 nfuel_cat ! fuel data; can be also set inside (cell based, fire grid)
317 real, intent(inout), dimension(ifms:ifme, jfms:jfme):: &
318 lfn,tign,fuel_frac, & ! state: level function, ign time, fuel left
319 uf,vf,lfn_out ! fire wind velocities
321 real, intent(out), dimension(ifms:ifme, jfms:jfme):: &
322 fire_area ! fraction of each cell burning
324 real, intent(out), dimension(ims:ime, kms:kme, jms:jme):: &
325 rthfrten,rqvfrten ! temperature and humidity tendencies (atm grid)
327 real, intent(out), dimension(ims:ime, jms:jme):: & ! redundant arrays, for display purposes only (atm grid)
328 grnhfx, & ! heat flux from ground fire (W/m^2)
329 grnqfx, & ! moisture flux from ground fire (W/m^2)
330 canhfx, & ! heat flux from crown fire (W/m^2)
331 canqfx ! moisture flux from crown fire (W/m^2)
333 real, intent(out), dimension(ifms:ifme, jfms:jfme):: & ! redundant arrays, for display only, fire grid
334 fgrnhfx, & ! heat flux from ground fire (W/m^2)
335 fgrnqfx, & ! moisture flux from ground fire (W/m^2)
336 fcanhfx, & ! heat flux from crown fire (W/m^2)
337 fcanqfx ! moisture flux from crown fire (W/m^2)
339 ! ***** data (constant in time) *****
341 real, dimension(ifms:ifme, jfms:jfme), intent(inout)::fxlong,fxlat ! fire mesh coordinates
343 real, intent(inout), dimension(ifms:ifme, jfms:jfme):: &
344 fuel_time,zsf, &
345 bbb,betafl,phiwc,r_0,fgip
346 integer, intent(inout), dimension(ifms:ifme, jfms:jfme):: ischap
348 !*** local
349 real :: dxf,dyf,time_start,latm
350 integer :: its,ite,jts,jte,kts,kte, & ! tile
351 ij,i,j,k,id,pid,kpe1, &
352 ifts,ifte,jfts,jfte ! fire tile
353 character(len=128)::msg
354 character(len=3)::kk
355 real:: unit_fxlong,unit_fxlat ! fxlong, fxlat units in m
358 !*** executable
360 ! time - assume dt does not change
361 time_start = itimestep * dt
363 ! fire mesh step
364 dxf=dx/ir
365 dyf=dy/jr
369 write(msg,'(a,2f15.6)')'atmosphere mesh step:',dx,dy
370 call message(msg)
371 write(msg,'(a,2f15.6)')'fire mesh step: ',dxf,dyf
372 call message(msg)
373 write(msg,7001)'atm domain ','ids',ids,ide,jds,jde
374 call message(msg)
375 write(msg,7001)'atm memory ','ims',ims,ime,jms,jme
376 call message(msg)
377 write(msg,7001)'atm patch ','ips',ips,ipe,jps,jpe
378 call message(msg)
379 write(msg,7001)'fire domain ','ifds',ifds,ifde,jfds,jfde
380 call message(msg)
381 write(msg,7001)'fire memory ','ifms',ifms,ifme,jfms,jfme
382 call message(msg)
383 write(msg,7001)'fire patch ','ifps',ifps,ifpe,jfps,jfpe
384 call message(msg)
386 ! check mesh dimensions
387 call check_fmesh(ids,ide,ifds,ifde,ir,'id') ! check if atm and fire grids line up
388 call check_fmesh(jds,jde,jfds,jfde,jr,'jd')
389 call check_fmesh(ips,ipe,ifps,ifpe,ir,'ip')
390 call check_fmesh(jps,jpe,jfps,jfpe,jr,'jp')
391 call check_mesh_2dim(ips,ipe,jps,jpe,ims,ime,jms,jme) ! check if atm patch fits in atm array
392 call check_mesh_2dim(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme) ! check if fire patch fits in fire array
393 call check_mesh_2dim(ips,ipe,jps,jpe,ids,ide,jds,jde) ! check if atm patch fits in atm domain
394 call check_mesh_2dim(ifps,ifpe,jfps,jfpe,ifds,ifde,jfds,jfde) ! check if fire patch fits in fire domain
396 ! init rest of fuel tables with derived constants
397 if(ifun.eq.1)call init_fuel_cats ! common for all threads
399 pid=0
400 if(itimestep.le.10.or.mod(itimestep,10).eq.0)pid=itimestep ! print 1-10 then every 10th
401 !pid=itimestep
403 if(ignition_longlat .eq.0)then
404 ! ignition is in m
405 unit_fxlong=1.
406 unit_fxlat=1.
407 ! will set fire mesh coordinates to uniform mesh below
408 else
409 ! check for zero long
410 if(xlong(ips,jps).eq.0. .and. xlong(ipe,jpe).eq. 0.) then
411 call crash('sfire_driver_phys: xlong xlat not set, use fire_ignition_longlat=0 or run real not ideal')
412 endif
413 ! 1 degree in m (approximate OK)
414 unit_fxlat=6378e3*2*3.14159/360. ! earth circumference in m / 360 degrees
415 unit_fxlong=cos(lat_ctr*3.14159/180.)*unit_fxlat ! latitude
416 ! will interpolate nodal coordinates to the fire mesh
417 endif
419 ! fake atm tile bounds
420 kts=kps
421 kte=kpe
423 ! set up fire tiles & interpolate to fire grid
424 !$OMP PARALLEL DO PRIVATE(ij,its,ite,jts,jte,ifts,ifte,jfts,jfte,msg,id) &
425 !$OMP SCHEDULE(STATIC)
426 do ij=1,num_tiles
428 id=0 ! do not print/write anything
429 if(itimestep.le.10.or.mod(itimestep,10).eq.0)id=itimestep+ij*10000
432 ! set up tile bounds
433 its = i_start(ij) ! start atmospheric tile in i
434 ite = i_end(ij) ! end atmospheric tile in i
435 jts = j_start(ij) ! start atmospheric tile in j
436 jte = j_end(ij) ! end atmospheric tile in j
437 ifts= (its-ids)*ir+ifds ! start fire tile in i
438 ifte= (ite-ids+1)*ir+ifds-1 ! end fire tile in i
439 jfts= (jts-jds)*jr+jfds ! start fire tile in j
440 jfte= (jte-jds+1)*jr+jfds-1 ! end fire tile in j
442 write(msg,*)'tile=',ij,' id=',id,' ifun=',ifun
443 call message(msg)
444 write(msg,7001)'atm tile ','its',its,ite,jts,jte
445 call message(msg)
446 write(msg,7001)'fire tile ','ifts',ifts,ifte,jfts,jfte
447 call message(msg)
449 ! check the tiles
450 call check_mesh_2dim(its,ite,jts,jte,ips,ipe,jps,jpe) ! check if atm tile fits in atm patch
451 call check_mesh_2dim(ifts,ifte,jfts,jfte,ifps,ifpe,jfps,jfpe) ! check if fire tile fits in fire patch
452 call check_mesh_2dim(ifts-2,ifte+2,jfts-2,jfte+2,ifms,ifme,jfms,jfme)! check if fire node tile fits in memory
455 write(msg,'(a,i6,a,2(f15.6,a))')'time step',itimestep,' at',time_start,' duration',dt,'s'
456 call message(msg)
457 7001 format(a,' dimensions ',a4,':',i6,' to ',i6,' by ',i6,' to ',i6)
458 write(msg,'(a,2i9)')'refinement ratio:',ir,jr
459 if(ifun.eq.1)then ! set terrain
461 call print_2d_stats(ips,ipe,jps,jpe,ims,ime,jms,jme,zs,'driver:zs')
463 ! interpolate terrain height
465 if(fire_topo_from_atm.eq.1)then
466 call interpolate_z2fire(id, & ! for debug output, <= 0 no output
467 ids,ide, jds,jde, & ! atm grid dimensions
468 ims,ime, jms,jme, &
469 ips,ipe,jps,jpe, &
470 its,ite,jts,jte, &
471 ifds, ifde, jfds, jfde, & ! fire grid dimensions
472 ifms, ifme, jfms, jfme, &
473 ifts,ifte,jfts,jfte, &
474 ir,jr, & ! atm/fire grid ratio
475 zs, & ! atm grid arrays in
476 zsf) ! fire grid arrays out
477 else
478 write(msg,'(a,i3,a)')'fire_topo_from_atm=',fire_topo_from_atm,' assuming ZSF set, interpolation skipped'
479 endif
481 if(ignition_longlat .eq.0)then
482 ! set ideal fire mesh coordinates - used for ignition only
483 ! do not forget to set unit_fxlong, unit_fxlat outside of parallel loop
484 call set_ideal_coord( dxf,dyf, &
485 ifds,ifde,jfds,jfde, &
486 ifms,ifme,jfms,jfme, &
487 ifts,ifte,jfts,jfte, &
488 fxlong,fxlat )
489 else
490 ! assume halo xlong xlat
491 ! interpolate nodal coordinates
493 #ifdef DEBUG_OUT
494 call write_array_m(its,ite,jts,jte,ims,ime,jms,jme,xlat,'xlat',id)
495 call write_array_m(its,ite,jts,jte,ims,ime,jms,jme,xlong,'xlong',id)
496 #endif
497 call interpolate_z2fire(id, & ! for debug output, <= 0 no output
498 ids,ide, jds,jde, & ! atm grid dimensions
499 ims,ime, jms,jme, &
500 ips,ipe,jps,jpe, &
501 its,ite,jts,jte, &
502 ifds, ifde, jfds, jfde, & ! fire grid dimensions
503 ifms, ifme, jfms, jfme, &
504 ifts,ifte,jfts,jfte, &
505 ir,jr, & ! atm/fire grid ratio
506 xlat, & ! atm grid arrays in
507 fxlat) ! fire grid arrays out
509 call interpolate_z2fire(id, & ! for debug output, <= 0 no output
510 ids,ide, jds,jde, & ! atm grid dimensions
511 ims,ime, jms,jme, &
512 ips,ipe,jps,jpe, &
513 its,ite,jts,jte, &
514 ifds, ifde, jfds, jfde, & ! fire grid dimensions
515 ifms, ifme, jfms, jfme, &
516 ifts,ifte,jfts,jfte, &
517 ir,jr, & ! atm/fire grid ratio
518 xlong, & ! atm grid arrays in
519 fxlong) ! fire grid arrays out
521 endif
523 elseif(ifun.eq.2)then
525 elseif(ifun.eq.3)then ! interpolate winds to the fire grid
527 call interpolate_atm2fire(id, & ! flag for debug output
528 ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
529 ims,ime, kms,kme, jms,jme, &
530 ips,ipe,jps,jpe, &
531 its,ite,jts,jte, &
532 ifds, ifde, jfds, jfde, & ! fire grid dimensions
533 ifms, ifme, jfms, jfme, &
534 ifts,ifte,jfts,jfte, &
535 ir,jr, & ! atm/fire grid ratio
536 u_frame, v_frame, & ! velocity frame correction
537 u,v, & ! atm grid arrays in
538 uf,vf) ! fire grid arrays out
540 endif
542 call sfire_model (id,ifun,need_lfn_update, &
543 num_ignitions, & ! switches
544 ifuelread,nfuel_cat0, & ! initialize fuel categories
545 ifds,ifde,jfds,jfde, & ! fire domain dims
546 ifms,ifme,jfms,jfme, & ! fire memory dims
547 ifps,ifpe,jfps,jfpe, &
548 ifts,ifte,jfts,jfte, & ! fire patch dims
549 time_start,dt, & ! time and increment
550 dxf,dyf, & ! fire mesh spacing
551 ignition_start_x,ignition_start_y, & ! ignition - small arrays
552 ignition_end_x,ignition_end_y, &
553 ignition_radius, &
554 ignition_time, &
555 fxlong,fxlat,unit_fxlong,unit_fxlat, & ! fire mesh coordinates
556 zsf, & ! terrain height (for gradient)
557 uf,vf, & ! input: wind
558 lfn,lfn_out,tign,fuel_frac, & ! state: level function, ign time, fuel left
559 fire_area, & ! output: fraction of cell burning
560 fgrnhfx,fgrnqfx, & ! output: heat fluxes
561 nfuel_cat, & ! fuel data per point
562 fuel_time, & ! save derived internal data
563 bbb,betafl,phiwc,r_0,fgip,ischap &
564 )
566 if(ifun.eq.6)then ! heat fluxes into the atmosphere
568 call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,fgrnhfx,'fire_driver:fgrnhfx')
569 call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,fgrnqfx,'fire_driver:fgrnqfx')
571 ! sum the fluxes over atm cells
572 call sum_2d_cells( &
573 ifms,ifme,jfms,jfme, &
574 ifts,ifte,jfts,jfte, &
575 fgrnhfx, &
576 ims, ime, jms, jme, &
577 its,ite,jts,jte, &
578 grnhfx)
579 !comment out the next call to get results as before commit 55fd92051196b796891b60cb7ec1c4bdb8800078
580 call sum_2d_cells( &
581 ifms,ifme,jfms,jfme, &
582 ifts,ifte,jfts,jfte, &
583 fgrnqfx, &
584 ims, ime, jms, jme, &
585 its,ite,jts,jte, &
586 grnqfx)
588 write(msg,'(a,f6.3)')'fire-atmosphere feedback scaling ',fire_atm_feedback
589 do j=jts,jte
590 do i=its,ite
591 ! scale ground fluxes to get the averages
592 grnhfx(i,j)=fire_atm_feedback*grnhfx(i,j)/(ir*jr)
593 grnqfx(i,j)=fire_atm_feedback*grnqfx(i,j)/(ir*jr)
594 ! we do not have canopy fluxes yet...
595 canhfx(i,j)=0
596 canqfx(i,j)=0
597 enddo
598 enddo
600 do j=jts,jte
601 do k=kts,min(kte+1,kde)
602 do i=its,ite
603 rthfrten(i,k,j)=0.
604 rqvfrten(i,k,j)=0.
605 enddo
606 enddo
607 enddo
610 ! --- add heat and moisture fluxes to tendency variables by postulated decay
612 call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme,grnhfx,'fire_driver:grnhfx')
613 call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme,grnqfx,'fire_driver:grnqfx')
615 call fire_tendency( &
616 ids,ide, kds,kde, jds,jde, & ! dimensions
617 ims,ime, kms,kme, jms,jme, &
618 its,ite, kts,kte, jts,jte, & !
619 grnhfx,grnqfx,canhfx,canqfx, & ! fluxes on atm grid
620 fire_ext_grnd,fire_ext_crwn,fire_crwn_hgt, &
621 zs,z_at_w,dz8w,mu,rho, &
622 rthfrten,rqvfrten) ! out
624 ! debug print to compare
626 call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,rthfrten,'fire_driver_phys:rthfrten')
627 call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,rqvfrten,'fire_driver_phys:rqvfrten')
630 endif ! ifun=6
632 enddo ! tiles
633 !$OMP END PARALLEL DO
635 if(ifun.eq.1)then
636 call print_2d_stats(ifts-1,ifte+1,jfts-1,jfte+1,ifms,ifme,jfms,jfme,zsf,'driver_phys:zsf')
637 #ifdef DEBUG_OUT
638 if(pid.ne.0)then
639 call write_array_m(ips,ipe,jps,jpe,ims,ime,jms,jme,zs,'zs',pid)
640 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,zsf,'zsf',pid)
641 endif
642 #endif
643 elseif(ifun.eq.3)then
644 #ifdef DEBUG_OUT
645 if(pid.gt.0)then
646 call write_array_m3(ips,ipe+1,kds,kds+1,jps,jpe+1,ims,ime,kms,kme,jms,jme,u,'u',pid)
647 call write_array_m3(ips,ipe+1,kds,kds+1,jps,jpe+1,ims,ime,kms,kme,jms,jme,v,'v',pid)
648 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,uf,'uf',pid)
649 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,vf,'vf',pid)
650 endif
651 #endif
652 elseif(ifun.eq.5)then
653 #ifdef DEBUG_OUT
654 if(pid.gt.0)then
655 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,lfn,'lfn',pid)
656 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,tign,'tign',pid)
657 endif
658 #endif
659 elseif(ifun.eq.6)then
660 #ifdef DEBUG_OUT
661 if(pid.gt.0)then
662 call write_array_m(ips,ipe,jps,jpe,ims,ime,jms,jme,grnhfx,'grnhfx',pid)
663 call write_array_m(ips,ipe,jps,jpe,ims,ime,jms,jme,grnqfx,'grnqfx',pid)
664 call write_array_m3(ips,ipe,kps,kpe,jps,jpe,ims,ime,kms,kme,jms,jme,rthfrten,'rthfrten',pid)
665 call write_array_m3(ips,ipe,kps,kpe,jps,jpe,ims,ime,kms,kme,jms,jme,rqvfrten,'rqvfrten',pid)
666 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,fuel_frac,'fuel_frac',pid)
667 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,fgrnhfx,'fgrnhfx',pid)
668 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,fgrnqfx,'fgrnqfx',pid)
669 endif
670 #endif
671 !call print_2d_stats(ips,ipe,jps,jpe,ims,ime,jms,jme,mu,'driver:mu')
672 !call print_3d_stats(ips,ipe,kps,kpe,jps,jpe,ims,ime,kms,kme,jms,jme,rho,'driver:rho')
673 kpe1=min(kps+1,kpe)
674 !kpe1=kps-1
675 do k=kts,min(kte,kts+3)
676 write(kk,'(i2)')k
677 call print_3d_stats(ips,ipe,k,k,jps,jpe,ims,ime,kms,kme,jms,jme,rthfrten,kk//'driver_phys:rthfrten')
678 call print_3d_stats(ips,ipe,k,k,jps,jpe,ims,ime,kms,kme,jms,jme,rqvfrten,kk//'driver_phys:rqvfrten')
679 enddo
680 endif
682 end subroutine sfire_driver_phys
683 !
684 !*******************
685 !
687 subroutine fire_ignition_convert (config_flags,fire_max_ignitions,ignition_longlat, &
688 fire_ignition_start_x,fire_ignition_start_y,fire_ignition_end_x,fire_ignition_end_y, &
689 fire_ignition_radius,fire_ignition_time,fire_num_ignitions)
690 USE module_configure
691 implicit none
692 !*** arguments
693 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
694 integer, intent(in)::fire_max_ignitions
695 real, dimension(fire_max_ignitions), intent(out):: &
696 fire_ignition_start_x,fire_ignition_start_y,fire_ignition_end_x,fire_ignition_end_y, &
697 fire_ignition_radius,fire_ignition_time
698 integer, intent(out)::fire_num_ignitions,ignition_longlat
699 !*** local
700 integer::i
701 logical:: real,ideal
702 !*** executable
703 ! this is only until I figure out how to input arrays through the namelist...
704 if(fire_max_ignitions.lt.5)call crash('fire_max_ignitions too small')
705 ! figure out which kind of coordinates from the first given
706 ideal=config_flags%fire_ignition_start_x1 .ne.0. .or. config_flags%fire_ignition_start_y1 .ne. 0.
707 real=config_flags%fire_ignition_start_long1 .ne. 0. .or. config_flags%fire_ignition_start_lat1 .ne. 0.
708 if(ideal)call message('Using ideal ignition coordinates, m from the lower left domain corner')
709 if(real)call message('Using real ignition coordinates, longitude and latitude')
710 if(ideal.and.real)call crash('Only one of the ideal or real coordinates may be given')
711 if(ideal)then
712 ! use values from _x and _y variables
713 ignition_longlat=0
714 fire_ignition_start_x(1)=config_flags%fire_ignition_start_x1
715 fire_ignition_start_y(1)=config_flags%fire_ignition_start_y1
716 fire_ignition_end_x(1)=config_flags%fire_ignition_end_x1
717 fire_ignition_end_y(1)=config_flags%fire_ignition_end_y1
718 fire_ignition_start_x(2)=config_flags%fire_ignition_start_x2
719 fire_ignition_start_y(2)=config_flags%fire_ignition_start_y2
720 fire_ignition_end_x(2)=config_flags%fire_ignition_end_x2
721 fire_ignition_end_y(2)=config_flags%fire_ignition_end_y2
722 fire_ignition_start_x(3)=config_flags%fire_ignition_start_x3
723 fire_ignition_start_y(3)=config_flags%fire_ignition_start_y3
724 fire_ignition_end_x(3)=config_flags%fire_ignition_end_x3
725 fire_ignition_end_y(3)=config_flags%fire_ignition_end_y3
726 fire_ignition_start_x(4)=config_flags%fire_ignition_start_x4
727 fire_ignition_start_y(4)=config_flags%fire_ignition_start_y4
728 fire_ignition_end_x(4)=config_flags%fire_ignition_end_x4
729 fire_ignition_end_y(4)=config_flags%fire_ignition_end_y4
730 fire_ignition_start_x(5)=config_flags%fire_ignition_start_x5
731 fire_ignition_start_y(5)=config_flags%fire_ignition_start_y5
732 fire_ignition_end_x(5)=config_flags%fire_ignition_end_x3
733 fire_ignition_end_y(5)=config_flags%fire_ignition_end_y3
734 endif
735 if(real)then
736 ! use values from _long and _lat
737 ignition_longlat=1
738 fire_ignition_start_x(1)=config_flags%fire_ignition_start_long1
739 fire_ignition_start_y(1)=config_flags%fire_ignition_start_lat1
740 fire_ignition_end_x(1)=config_flags%fire_ignition_end_long1
741 fire_ignition_end_y(1)=config_flags%fire_ignition_end_lat1
742 fire_ignition_start_x(2)=config_flags%fire_ignition_start_long2
743 fire_ignition_start_y(2)=config_flags%fire_ignition_start_lat2
744 fire_ignition_end_x(2)=config_flags%fire_ignition_end_long2
745 fire_ignition_end_y(2)=config_flags%fire_ignition_end_lat2
746 fire_ignition_start_x(3)=config_flags%fire_ignition_start_long3
747 fire_ignition_start_y(3)=config_flags%fire_ignition_start_lat3
748 fire_ignition_end_x(3)=config_flags%fire_ignition_end_long3
749 fire_ignition_end_y(3)=config_flags%fire_ignition_end_lat3
750 fire_ignition_start_x(4)=config_flags%fire_ignition_start_long4
751 fire_ignition_start_y(4)=config_flags%fire_ignition_start_lat4
752 fire_ignition_end_x(4)=config_flags%fire_ignition_end_long4
753 fire_ignition_end_y(4)=config_flags%fire_ignition_end_lat4
754 fire_ignition_start_x(5)=config_flags%fire_ignition_start_long5
755 fire_ignition_start_y(5)=config_flags%fire_ignition_start_lat5
756 fire_ignition_end_x(5)=config_flags%fire_ignition_end_long3
757 fire_ignition_end_y(5)=config_flags%fire_ignition_end_lat3
758 endif
759 ! common to both cases
760 fire_ignition_radius(1)=config_flags%fire_ignition_radius1
761 fire_ignition_time(1)=config_flags%fire_ignition_time1
762 fire_ignition_radius(2)=config_flags%fire_ignition_radius2
763 fire_ignition_time(2)=config_flags%fire_ignition_time2
764 fire_ignition_radius(3)=config_flags%fire_ignition_radius3
765 fire_ignition_time(3)=config_flags%fire_ignition_time3
766 fire_ignition_radius(4)=config_flags%fire_ignition_radius4
767 fire_ignition_time(4)=config_flags%fire_ignition_time4
768 fire_ignition_radius(5)=config_flags%fire_ignition_radius5
769 fire_ignition_time(5)=config_flags%fire_ignition_time5
771 !
772 fire_num_ignitions=0
773 do i=1,min(5,config_flags%fire_num_ignitions)
774 ! count the ignitions
775 if(fire_ignition_radius(i).gt.0.)fire_num_ignitions=i
776 ! expand the point ignitions given as zero
777 if(fire_ignition_end_x(i).eq.0.)fire_ignition_end_x(i)=fire_ignition_start_x(i)
778 if(fire_ignition_end_y(i).eq.0.)fire_ignition_end_y(i)=fire_ignition_start_y(i)
779 enddo
781 end subroutine fire_ignition_convert
783 !
784 !*****************************
785 !
786 !module_fr_sfire_driver%%interpolate_atm2fire
788 subroutine interpolate_atm2fire(id, & ! for debug output, <= 0 no output
789 ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
790 ims,ime, kms,kme, jms,jme, &
791 ips,ipe,jps,jpe, &
792 its,ite,jts,jte, &
793 ifds, ifde, jfds, jfde, & ! fire grid dimensions
794 ifms, ifme, jfms, jfme, &
795 ifts,ifte,jfts,jfte, &
796 ir,jr, & ! atm/fire grid ratio
797 u_frame, v_frame, & ! velocity frame correction
798 u,v, & ! atm grid arrays in
799 uf,vf) ! fire grid arrays out
801 implicit none
802 !*** purpose: interpolate winds and height
804 !*** arguments
805 integer, intent(in)::id, &
806 ids,ide, kds,kde, jds,jde, & ! atm domain bounds
807 ims,ime, kms,kme, jms,jme, & ! atm memory bounds
808 ips,ipe,jps,jpe, &
809 its,ite,jts,jte, & ! atm tile bounds
810 ifds, ifde, jfds, jfde, & ! fire domain bounds
811 ifms, ifme, jfms, jfme, & ! fire memory bounds
812 ifts,ifte,jfts,jfte, & ! fire tile bounds
813 ir,jr ! atm/fire grid refinement ratio
814 real, intent(in):: u_frame, v_frame ! velocity frame correction
815 real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::&
816 u,v ! atm wind velocity, staggered
817 real,intent(out), dimension(ifms:ifme,jfms:jfme)::&
818 uf,vf ! wind velocity fire grid nodes
821 !*** local
822 #define TDIMS its-1,ite+2,jts-1,jte+2
823 real, dimension(its-1:ite+2,jts-1:jte+2):: ua,va ! atm winds, averaged over height
824 integer:: i,j,k,ifts1,ifte1,jfts1,jfte1
826 !*** executable
828 k=kds ! the ground
829 do j = jts-1,jte+2
830 do i = its-1,ite+2
831 ! average 1st 2 layers, correct const shift
832 ua(i,j)=0.5*( u(i,k,j) + u(i,k+1,j)) + u_frame
833 va(i,j)=0.5*( v(i,k,j) + v(i,k+1,j)) + v_frame
834 enddo
835 enddo
837 ! extend the winds by one beyond the domain boundary
838 call continue_at_boundary(1,0,0., & ! do x direction or y direction
839 TDIMS, & ! memory dims
840 ids,ide+1,jds,jde+1, & ! domain dims - winds defined up to +1
841 ips,ipe+1,jps,jpe+1, & ! patch dims - winds defined up to +1
842 its,ite+1,jts,jte+1, & ! tile dims
843 va) ! array
845 call continue_at_boundary(0,1,0., & ! do x direction or y direction
846 TDIMS, & ! memory dims
847 ids,ide+1,jds,jde+1, & ! domain dims - winds defined up to +1
848 ips,ipe+1,jps,jpe+1, & ! patch dims - winds defined up to +1
849 its,ite+1,jts,jte+1, & ! tile dims
850 ua) ! array
852 !if (id.gt.0) then
853 ! call write_array_m(TDIMS,TDIMS,ua,'ua',id)
854 ! call write_array_m(TDIMS,TDIMS,va,'va',id)
855 !endif
857 call print_2d_stats_vec(its,ite+1,jts,jte+1,TDIMS,ua,va, &
858 'driver: atm wind (m/s)')
861 ! ---------------
862 ! | F | F | F | F | Example of atmospheric and fire grid with
863 ! |-------|-------| ir=jr=4.
864 ! | F | F | F | F | Winds are given at the midpoints of the sides of the coarse grid,
865 ! u-------z-------| interpolated to midpoints of the cells of the fine fire grid F.
866 ! | F | F | F | F |
867 ! |---------------|
868 ! | * | F | F | F |
869 ! -------v-------
870 !
871 ! Meshes are aligned by the lower left cell of the domain. Then in the above figure
872 ! u = node with the ua component of the wind at (ids,jds), midpoint of side
873 ! v = node with the va component of the wind at (ids,jds), midpoint of side
874 ! * = fire grid node at (ifds,jfds)
875 ! z = node with height, midpoint of cell
876 !
877 ! ua(ids,jds)=uf(ifds-0.5,jfds+jr/2+0.5)
878 ! va(ids,jds)=vf(ifds+ir/2+0.5,jfds-0.5)
879 ! za(ids,jds)=zsf(ifds+ir/2+0.5,jfds+jr/2+0.5)
881 ifts1=snode(ifts,ifds,-1) ! go 1 beyond domain boundary but not between tiles
882 ifte1=snode(ifte,ifde,+1)
883 jfts1=snode(jfts,jfds,-1)
884 jfte1=snode(jfte,jfde,+1)
886 call interpolate_2d( &
887 TDIMS, & ! memory dims atm grid tile
888 TDIMS, & ! where atm grid values set
889 ifms,ifme,jfms,jfme, & ! array dims fire grid
890 ifts1,ifte1,jfts1,jfte1,& ! dimensions on the fire grid to interpolate to
891 ir,jr, & ! refinement ratio
892 real(ids),real(jds),ifds-.5,jfds+(jr+1)*.5, & ! line up by lower left corner of domain
893 ua, & ! in atm grid
894 uf) ! out fire grid
896 call interpolate_2d( &
897 TDIMS, & ! memory dims atm grid tile
898 TDIMS, & ! where atm grid values set
899 ifms,ifme,jfms,jfme, & ! array dims fire grid
900 ifts1,ifte1,jfts1,jfte1,& ! dimensions on the fire grid to interpolate to
901 ir,jr, & ! refinement ratio
902 real(ids),real(jds),ifds+(ir+1)*.5,jfds-0.5, & ! line up by lower left corner of domain
903 va, & ! in atm grid
904 vf) ! out fire grid
906 !call print_2d_stats_vec(ifts-1,ifte+1,jfts-1,jfte+1,ifms,ifme,jfms,jfme,uf,vf,'fire wind (m/s)')
909 end subroutine interpolate_atm2fire
911 !
912 !*****************************
913 !
915 subroutine interpolate_z2fire(id, & ! for debug output, <= 0 no output
916 ids,ide, jds,jde, & ! atm grid dimensions
917 ims,ime, jms,jme, &
918 ips,ipe,jps,jpe, &
919 its,ite,jts,jte, &
920 ifds, ifde, jfds, jfde, & ! fire grid dimensions
921 ifms, ifme, jfms, jfme, &
922 ifts,ifte,jfts,jfte, &
923 ir,jr, & ! atm/fire grid ratio
924 zs, & ! atm grid arrays in
925 zsf) ! fire grid arrays out
927 implicit none
928 !*** purpose: interpolate height
930 !*** arguments
931 integer, intent(in)::id, &
932 ids,ide, jds,jde, & ! atm domain bounds
933 ims,ime,jms,jme, & ! atm memory bounds
934 ips,ipe,jps,jpe, &
935 its,ite,jts,jte, & ! atm tile bounds
936 ifds, ifde, jfds, jfde, & ! fire domain bounds
937 ifms, ifme, jfms, jfme, & ! fire memory bounds
938 ifts,ifte,jfts,jfte, & ! fire tile bounds
939 ir,jr ! atm/fire grid refinement ratio
940 real, intent(in), dimension(ims:ime, jms:jme):: zs ! terrain height at atm cell centers & ! terrain height
941 real,intent(out), dimension(ifms:ifme,jfms:jfme)::&
942 zsf ! terrain height fire grid nodes
945 !*** local
946 real, dimension(its-2:ite+2,jts-2:jte+2):: za ! terrain height
947 integer:: i,j,jts1,jte1,its1,ite1,jfts1,jfte1,ifts1,ifte1
949 ! terrain height
951 jts1=max(jts-1,jds) ! lower loop limit by one less when at end of domain
952 its1=max(its-1,ids) ! ASSUMES THE HALO IS THERE if patch != domain
953 jte1=min(jte+1,jde)
954 ite1=min(ite+1,ide)
955 do j = jts1,jte1
956 do i = its1,ite1
957 ! copy to local array
958 za(i,j)=zs(i,j)
959 enddo
960 enddo
962 call continue_at_boundary(1,1,0., & ! do x direction or y direction
963 its-2,ite+2,jts-2,jte+2, & ! memory dims
964 ids,ide,jds,jde, & ! domain dims - winds defined up to +1
965 ips,ipe,jps,jpe, & ! patch dims - winds defined up to +1
966 its1,ite1,jts1,jte1, & ! tile dims
967 za) ! array
969 ! interpolate to tile plus strip along domain boundary if at boundary
970 jfts1=snode(jfts,jfds,-1) ! lower loop limit by one less when at end of domain
971 ifts1=snode(ifts,ifds,-1)
972 jfte1=snode(jfte,jfde,+1)
973 ifte1=snode(ifte,ifde,+1)
975 call interpolate_2d( &
976 its-2,ite+2,jts-2,jte+2, & ! memory dims atm grid tile
977 its1-1,ite1+1,jts1-1,jte1+1, & ! where atm grid values set
978 ifms,ifme,jfms,jfme, & ! array dims fire grid
979 ifts1,ifte1,jfts1,jfte1, & ! dimensions fire grid tile
980 ir,jr, & ! refinement ratio
981 real(ids),real(jds),ifds+(ir+1)*.5,jfds+(jr+1)*.5, & ! line up by lower left corner of domain
982 za, & ! in atm grid
983 zsf) ! out fire grid
985 end subroutine interpolate_z2fire
986 !
987 !*****************************
988 !
990 subroutine check_fmesh(ids,ide,ifds,ifde,ir,s)
991 !*** purpose: check if fire and atm meshes line up
992 implicit none
993 !*** arguments
994 integer, intent(in)::ids,ide,ifds,ifde,ir
995 character(len=*),intent(in)::s
996 !*** local
997 character(len=128)msg
998 !*** executable
999 if ((ide-ids+1)*ir.ne.(ifde-ifds+1))then
1000 write(msg,1)s,ids,ide,ifds,ifde,ir
1001 1 format('module_fr_sfire_driver: incompatible bounds ',a,' atm ',i5,':',i5,' fire ',i5,':',i5,' ratio ',i3)
1002 call crash(msg)
1003 endif
1004 end subroutine check_fmesh
1006 !
1007 !*****************************
1008 !
1009 subroutine set_flags(config_flags)
1010 USE module_configure
1011 use module_fr_sfire_util
1012 implicit none
1013 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1014 ! copy flags from wrf to module_fr_sfire_util
1015 ! for instructions how to add a flag see the top of module_fr_sfire_util.F
1018 fire_print_msg = config_flags%fire_print_msg
1019 fire_print_file = config_flags%fire_print_file
1020 fuel_left_method = config_flags%fire_fuel_left_method
1021 fuel_left_irl = config_flags%fire_fuel_left_irl
1022 fuel_left_jrl = config_flags%fire_fuel_left_jrl
1023 fire_atm_feedback = config_flags%fire_atm_feedback
1024 boundary_guard = config_flags%fire_boundary_guard
1025 fire_back_weight = config_flags%fire_back_weight
1026 fire_grows_only = config_flags%fire_grows_only
1027 fire_upwinding = config_flags%fire_upwinding
1028 fire_upwind_split = config_flags%fire_upwind_split
1029 fire_viscosity = config_flags%fire_viscosity
1030 fire_lfn_ext_up = config_flags%fire_lfn_ext_up
1031 fire_test_steps = config_flags%fire_test_steps
1032 fire_topo_from_atm = config_flags%fire_topo_from_atm
1037 end subroutine set_flags
1039 subroutine print_id
1040 character(len=128)::id,msg
1041 #include "sfire_id.inc"
1042 msg='version '//id
1043 call message(msg)
1044 end subroutine print_id
1046 end module module_fr_sfire_driver