| blob | 026911bfeac47b190ced68db4294680364c04569 |
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 #ifdef DM_PARALLEL
77 USE module_dm , ONLY : ntasks_x,ntasks_y,local_communicator,mytask,ntasks
78 USE module_comm_dm , ONLY : halo_fire_lfn_sub,halo_fire_longlat_sub,halo_fire_ht_sub &
79 ,halo_fire_zsf_sub, halo_fire_fuel_sub,halo_fire_wind_a_sub &
80 ,halo_fire_wind_f_sub,halo_fire_tign_sub
81 #endif
83 implicit none
84 !*** arguments
85 TYPE(domain) , TARGET :: grid ! data
86 ! Structure that contains run-time configuration (namelist) data for domain
87 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
88 integer, intent(in):: &
89 ids,ide, kds,kde, jds,jde &
90 ,ims,ime, kms,kme, jms,jme &
91 ,ips,ipe, kps,kpe, jps,jpe &
92 ,ifds,ifde, jfds,jfde &
93 ,ifms,ifme, jfms,jfme &
94 ,ifps,ifpe, jfps,jfpe
95 real,intent(in),dimension(ims:ime, kms:kme, jms:jme)::rho, &! air density (kg/m^3) (cell based, atm grid)
96 z_at_w,dz8w ! ????????
98 !*** local
99 INTEGER:: fire_num_ignitions
100 integer, parameter::fire_max_ignitions=5
101 REAL, DIMENSION(fire_max_ignitions):: fire_ignition_start_x, &
102 fire_ignition_start_y, &
103 fire_ignition_end_x, &
104 fire_ignition_end_y, &
105 fire_ignition_time, &
106 fire_ignition_radius
107 integer::fire_ifun,fire_ifun_start,ir,jr,fire_ignition_longlat,istep,itimestep
108 logical::need_lfn_update
109 !real, dimension(ifms:ifme, jfms:jfme)::uf,vf,lfn_out
110 ! uf vf only do not need to be in the state but we need halo on them
111 real, dimension(ifms:ifme, jfms:jfme)::lfn_out
112 real::lat_ctr,lon_ctr
114 !*** executable
116 call print_id
119 ! populate our structures from wrf
120 call fire_ignition_convert (config_flags,fire_max_ignitions,fire_ignition_longlat, &
121 fire_ignition_start_x,fire_ignition_start_y,fire_ignition_end_x,fire_ignition_end_y, &
122 fire_ignition_radius,fire_ignition_time,fire_num_ignitions)
123 call set_flags(config_flags)
125 ir=grid%sr_x ! refinement ratio
126 jr=grid%sr_y
127 itimestep=grid%itimestep
129 lat_ctr=config_flags%cen_lat
130 lon_ctr=config_flags%cen_lon
132 do istep=0,fire_test_steps ! istep >0 is for testing only, exit after the first call
133 itimestep = itimestep + istep ! in the first call, do fire_test_steps steps of the fire model
135 fire_ifun_start=1 ! initialize?
136 if(itimestep.ne.1)fire_ifun_start=3 ! should find a better distinction when to initialize
138 need_lfn_update=.false.
139 do fire_ifun=fire_ifun_start,6
141 ! 1 = initialize run pass 1: interpolate height to zsf=terrain
142 ! 2 = initialize run pass 2: set fuel data, terrain gradient
143 ! 3 = initialize timestep: interpolate winds, check for ignition
144 ! 4 = do one timestep
145 ! 5 = copy timestep output to input
146 ! 6 = compute output fluxes
148 #ifdef DM_PARALLEL
149 if(need_lfn_update)then
150 ! halo exchange on lfn width 2
151 #include "HALO_FIRE_LFN.inc"
152 endif
154 if(fire_ifun.eq.1)then
155 ! halo exchange on topography
156 #include "HALO_FIRE_LONGLAT.inc"
157 if(fire_topo_from_atm.eq.1)then
158 #include "HALO_FIRE_HT.inc"
159 endif
161 elseif(fire_ifun.eq.2)then
162 ! halo exchange on zsf width 2
163 #include "HALO_FIRE_ZSF.inc"
165 elseif(fire_ifun.eq.3)then
166 if(fire_ifun_start<3)then
167 ! halo exchange on all fuel data width 2
168 #include "HALO_FIRE_FUEL.inc"
169 endif
170 ! halo exchange on atm winds width 1 for interpolation
171 #include "HALO_FIRE_WIND_A.inc"
173 elseif(fire_ifun.eq.4)then
174 ! halo exchange on fire winds width 2 for a 2-step RK method
175 #include "HALO_FIRE_WIND_F.inc"
177 elseif(fire_ifun.eq.6)then
178 ! computing fuel_left needs ignition time from neighbors
179 #include "HALO_FIRE_TIGN.inc"
181 endif
182 #endif
183 ! need domain by 1 smaller, in last row.col winds are not set properly
184 call sfire_driver_phys ( &
185 fire_ifun,need_lfn_update, &
186 ids,ide-1, kds,kde, jds,jde-1, &
187 ims,ime, kms,kme, jms,jme, &
188 ips,min(ipe,ide-1), kps,kpe, jps,min(jpe,jde-1), &
189 ifds,ifde-ir, jfds,jfde-jr, &
190 ifms,ifme, jfms,jfme, &
191 ifps,min(ifpe,ifde-ir), jfps,min(jfpe,jfde-jr), &
192 ir,jr, & ! atm/fire grid ratio
193 grid%num_tiles, & ! atm grid tiling
194 grid%i_start,min(grid%i_end,ide-1), &
195 grid%j_start,min(grid%j_end,jde-1), &
196 itimestep,config_flags%fire_fuel_read,config_flags%fire_fuel_cat, & ! in scalars
197 grid%dt,grid%dx,grid%dy, &
198 grid%u_frame,grid%v_frame, &
199 lat_ctr,lon_ctr, & ! coordinates of grid center
200 config_flags%fire_ext_grnd,config_flags%fire_ext_crwn,config_flags%fire_crwn_hgt, &
201 fire_num_ignitions, &
202 fire_ignition_longlat, &
203 fire_ignition_start_x,fire_ignition_start_y, & ! ignition - small arrays
204 fire_ignition_end_x,fire_ignition_end_y, &
205 fire_ignition_radius,fire_ignition_time, &
206 grid%u_2,grid%v_2,grid%mut,rho,grid%ht, & ! in arrays, on atm grid
207 z_at_w,dz8w, &
208 grid%xlong,grid%xlat, & ! coordinates of atm grid centers, for ignition location
209 grid%lfn,grid%tign_g,grid%fuel_frac, & ! state arrays, fire grid
210 grid%fire_area, & ! redundant, for display, fire grid
211 grid%uf,grid%vf,lfn_out, & ! arrays to persist only over one timestep
212 grid%rthfrten,grid%rqvfrten, & ! out arrays, atm grid
213 grid%grnhfx,grid%grnqfx,grid%canhfx,grid%canqfx, & ! out redundant arrays, atm grid
214 grid%fgrnhfx,grid%fgrnqfx,grid%fcanhfx,grid%fcanqfx, & ! out redundant arrays, atm grid
215 grid%fxlong,grid%fxlat, &
216 grid%nfuel_cat, & ! input, or internal for safekeeping
217 grid%fuel_time,grid%zsf, &
218 grid%bbb,grid%betafl,grid%phiwc,grid%r_0,grid%fgip,grid%ischap&
219 )
220 enddo
221 enddo
222 if(fire_test_steps>0)call crash('sfire_driver_em: test run of uncoupled fire model completed')
224 end subroutine sfire_driver_em
226 !
227 !*******************
228 !
230 ! module_fr_sfire_driver%%sfire_driver
231 subroutine sfire_driver_phys (ifun,need_lfn_update, &
232 ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
233 ims,ime, kms,kme, jms,jme, &
234 ips,ipe, kps,kpe, jps,jpe, &
235 ifds, ifde, jfds, jfde, & ! fire grid dimensions
236 ifms, ifme, jfms, jfme, &
237 ifps, ifpe, jfps, jfpe, & ! fire patch in - will use smaller
238 ir,jr, & ! atm/fire grid ratio
239 num_tiles,i_start,i_end,j_start,j_end, & ! atm grid tiling
240 itimestep,ifuelread,nfuel_cat0,dt,dx,dy, & ! in scalars
241 u_frame,v_frame, &
242 lat_ctr,lon_ctr, &
243 fire_ext_grnd,fire_ext_crwn,fire_crwn_hgt, &
244 num_ignitions, &
245 ignition_longlat, &
246 ignition_start_x,ignition_start_y, & ! ignition - small arrays
247 ignition_end_x,ignition_end_y, &
248 ignition_radius, &
249 ignition_time, &
250 u,v,mu,rho,zs, & ! in arrays, atm grid
251 z_at_w,dz8w, &
252 xlong,xlat, &
253 lfn,tign,fuel_frac, & ! state arrays, fire grid
254 fire_area, & ! redundant state, fire grid
255 uf,vf,lfn_out, & ! fire wind velocities, out level set function
256 rthfrten,rqvfrten, & ! out arrays, atm grid
257 grnhfx,grnqfx,canhfx,canqfx, & ! out redundant arrays, atm grid
258 fgrnhfx,fgrnqfx,fcanhfx,fcanqfx, & ! out redundant arrays, fire grid
259 fxlong,fxlat, & !
260 nfuel_cat, & ! in array, data, fire grid, or constant internal
261 fuel_time,zsf, & ! save constant internal data, fire grid
262 bbb,betafl,phiwc,r_0,fgip,ischap&
263 )
265 implicit none
267 !*** arguments
269 integer, intent(in)::ifun, &
270 ids,ide, kds,kde, jds,jde, & ! atm domain bounds
271 ims,ime, kms,kme, jms,jme, & ! atm memory bounds
272 ips,ipe, kps,kpe, jps,jpe, & ! atm patch bounds
273 ifds, ifde, jfds, jfde, & ! fire domain bounds
274 ifms, ifme, jfms, jfme, & ! fire memory bounds
275 ifps, ifpe, jfps, jfpe, & ! fire patch bounds
276 ir,jr, & ! atm/fire grid refinement ratio
277 itimestep, & ! number of this timestep
278 ifuelread, & ! how to initialize nfuel_cat:
279 ! -1=not at all, done outside
280 ! 0=from nfuel_cat0
281 ! 1=from altitude
282 ! 2=from file
283 nfuel_cat0, & ! fuel category to initialize everything to
284 num_tiles ! number of tiles
287 logical, intent(out)::need_lfn_update
289 integer,dimension(num_tiles),intent(in) :: i_start,i_end,j_start,j_end ! atm grid tiling
291 real, intent(in):: &
292 dt, & ! time step
293 dx,dy, & ! atm grid step
294 u_frame,v_frame, & ! velocity offset
295 lat_ctr,lon_ctr, & ! coordinates of domain center
296 fire_crwn_hgt, & ! lowest height crown fire heat is released (m)
297 fire_ext_grnd, & ! extinction depth of ground fire heat (m)
298 fire_ext_crwn ! extinction depth of crown fire heat (m)
301 integer, intent(in):: num_ignitions ! number of ignitions, can be 0
302 real, dimension(num_ignitions), intent(in):: &
303 ignition_start_x,ignition_start_y, &
304 ignition_end_x,ignition_end_y,ignition_radius, & ! start, end, radius, time
305 ignition_time ! of ignition lines
306 integer, intent(in):: ignition_longlat ! if 1 ignition give as long/lat, otherwise as m from lower left corner
308 real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::u,v ! wind velocity (m/s) (node based, atm grid)
309 real,intent(in),dimension(ims:ime,jms:jme)::mu ! dry air mass (Pa) pressure?? (cell based, atm grid)
310 real,intent(in),dimension(ims:ime, jms:jme):: zs ! terrain height
311 real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::rho, & ! air density (kg/m^3) (cell based, atm grid)
312 z_at_w,dz8w ! height of some sort??
314 real, dimension(ims:ime, jms:jme), intent(inout)::xlong, xlat ! inout because of extension at bdry
316 real, intent(inout), dimension(ifms:ifme,jfms:jfme):: &
317 nfuel_cat ! fuel data; can be also set inside (cell based, fire grid)
319 real, intent(inout), dimension(ifms:ifme, jfms:jfme):: &
320 lfn,tign,fuel_frac, & ! state: level function, ign time, fuel left
321 uf,vf,lfn_out ! fire wind velocities
323 real, intent(out), dimension(ifms:ifme, jfms:jfme):: &
324 fire_area ! fraction of each cell burning
326 real, intent(out), dimension(ims:ime, kms:kme, jms:jme):: &
327 rthfrten,rqvfrten ! temperature and humidity tendencies (atm grid)
329 real, intent(out), dimension(ims:ime, jms:jme):: & ! redundant arrays, for display purposes only (atm grid)
330 grnhfx, & ! heat flux from ground fire (W/m^2)
331 grnqfx, & ! moisture flux from ground fire (W/m^2)
332 canhfx, & ! heat flux from crown fire (W/m^2)
333 canqfx ! moisture flux from crown fire (W/m^2)
335 real, intent(out), dimension(ifms:ifme, jfms:jfme):: & ! redundant arrays, for display only, fire grid
336 fgrnhfx, & ! heat flux from ground fire (W/m^2)
337 fgrnqfx, & ! moisture flux from ground fire (W/m^2)
338 fcanhfx, & ! heat flux from crown fire (W/m^2)
339 fcanqfx ! moisture flux from crown fire (W/m^2)
341 ! ***** data (constant in time) *****
343 real, dimension(ifms:ifme, jfms:jfme), intent(inout)::fxlong,fxlat ! fire mesh coordinates
345 real, intent(inout), dimension(ifms:ifme, jfms:jfme):: &
346 fuel_time,zsf, &
347 bbb,betafl,phiwc,r_0,fgip
348 integer, intent(inout), dimension(ifms:ifme, jfms:jfme):: ischap
350 !*** local
351 real :: dxf,dyf,time_start,latm
352 integer :: its,ite,jts,jte,kts,kte, & ! tile
353 ij,i,j,k,id,pid,kpe1, &
354 ifts,ifte,jfts,jfte ! fire tile
355 character(len=128)::msg
356 character(len=3)::kk
357 real:: unit_fxlong,unit_fxlat ! fxlong, fxlat units in m
360 !*** executable
362 ! time - assume dt does not change
363 time_start = itimestep * dt
365 ! fire mesh step
366 dxf=dx/ir
367 dyf=dy/jr
371 write(msg,'(a,2f15.6)')'atmosphere mesh step:',dx,dy
372 call message(msg)
373 write(msg,'(a,2f15.6)')'fire mesh step: ',dxf,dyf
374 call message(msg)
375 write(msg,7001)'atm domain ','ids',ids,ide,jds,jde
376 call message(msg)
377 write(msg,7001)'atm memory ','ims',ims,ime,jms,jme
378 call message(msg)
379 write(msg,7001)'atm patch ','ips',ips,ipe,jps,jpe
380 call message(msg)
381 write(msg,7001)'fire domain ','ifds',ifds,ifde,jfds,jfde
382 call message(msg)
383 write(msg,7001)'fire memory ','ifms',ifms,ifme,jfms,jfme
384 call message(msg)
385 write(msg,7001)'fire patch ','ifps',ifps,ifpe,jfps,jfpe
386 call message(msg)
388 ! check mesh dimensions
389 call check_fmesh(ids,ide,ifds,ifde,ir,'id') ! check if atm and fire grids line up
390 call check_fmesh(jds,jde,jfds,jfde,jr,'jd')
391 call check_fmesh(ips,ipe,ifps,ifpe,ir,'ip')
392 call check_fmesh(jps,jpe,jfps,jfpe,jr,'jp')
393 call check_mesh_2dim(ips,ipe,jps,jpe,ims,ime,jms,jme) ! check if atm patch fits in atm array
394 call check_mesh_2dim(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme) ! check if fire patch fits in fire array
395 call check_mesh_2dim(ips,ipe,jps,jpe,ids,ide,jds,jde) ! check if atm patch fits in atm domain
396 call check_mesh_2dim(ifps,ifpe,jfps,jfpe,ifds,ifde,jfds,jfde) ! check if fire patch fits in fire domain
398 !$OMP SINGLE
399 ! init rest of fuel tables with derived constants
400 if(ifun.eq.1) then
401 call init_fuel_cats ! common for all threads
402 endif
403 !$OMP END SINGLE
406 pid=0
407 if(itimestep.le.10.or.mod(itimestep,10).eq.0)pid=itimestep ! print 1-10 then every 10th
408 !pid=itimestep
410 if(ignition_longlat .eq.0)then
411 ! ignition is in m
412 unit_fxlong=1.
413 unit_fxlat=1.
414 ! will set fire mesh coordinates to uniform mesh below
415 else
416 ! check for zero long
417 if(xlong(ips,jps).eq.0. .and. xlong(ipe,jpe).eq. 0.) then
418 call crash('sfire_driver_phys: xlong xlat not set, use fire_ignition_longlat=0 or run real not ideal')
419 endif
420 ! 1 degree in m (approximate OK)
421 unit_fxlat=6378e3*2*3.14159/360. ! earth circumference in m / 360 degrees
422 unit_fxlong=cos(lat_ctr*3.14159/180.)*unit_fxlat ! latitude
423 ! will interpolate nodal coordinates to the fire mesh
424 endif
426 ! fake atm tile bounds
427 kts=kps
428 kte=kpe
430 ! set up fire tiles & interpolate to fire grid
431 !$OMP PARALLEL DO PRIVATE(ij,its,ite,jts,jte,ifts,ifte,jfts,jfte,msg,id) &
432 !$OMP SCHEDULE(STATIC)
433 do ij=1,num_tiles
435 id=0 ! do not print/write anything
436 if(itimestep.le.10.or.mod(itimestep,10).eq.0)id=itimestep+ij*10000
439 ! set up tile bounds
440 its = i_start(ij) ! start atmospheric tile in i
441 ite = i_end(ij) ! end atmospheric tile in i
442 jts = j_start(ij) ! start atmospheric tile in j
443 jte = j_end(ij) ! end atmospheric tile in j
444 ifts= (its-ids)*ir+ifds ! start fire tile in i
445 ifte= (ite-ids+1)*ir+ifds-1 ! end fire tile in i
446 jfts= (jts-jds)*jr+jfds ! start fire tile in j
447 jfte= (jte-jds+1)*jr+jfds-1 ! end fire tile in j
449 write(msg,*)'tile=',ij,' id=',id,' ifun=',ifun
450 call message(msg)
451 write(msg,7001)'atm tile ','its',its,ite,jts,jte
452 call message(msg)
453 write(msg,7001)'fire tile ','ifts',ifts,ifte,jfts,jfte
454 call message(msg)
456 ! check the tiles
457 call check_mesh_2dim(its,ite,jts,jte,ips,ipe,jps,jpe) ! check if atm tile fits in atm patch
458 call check_mesh_2dim(ifts,ifte,jfts,jfte,ifps,ifpe,jfps,jfpe) ! check if fire tile fits in fire patch
459 call check_mesh_2dim(ifts-2,ifte+2,jfts-2,jfte+2,ifms,ifme,jfms,jfme)! check if fire node tile fits in memory
462 write(msg,'(a,i6,a,2(f15.6,a))')'time step',itimestep,' at',time_start,' duration',dt,'s'
463 call message(msg)
464 7001 format(a,' dimensions ',a4,':',i6,' to ',i6,' by ',i6,' to ',i6)
465 write(msg,'(a,2i9)')'refinement ratio:',ir,jr
466 if(ifun.eq.1)then ! set terrain
468 call print_2d_stats(ips,ipe,jps,jpe,ims,ime,jms,jme,zs,'driver:zs')
470 ! interpolate terrain height
472 if(fire_topo_from_atm.eq.1)then
473 call interpolate_z2fire(id, & ! for debug output, <= 0 no output
474 ids,ide, jds,jde, & ! atm grid dimensions
475 ims,ime, jms,jme, &
476 ips,ipe,jps,jpe, &
477 its,ite,jts,jte, &
478 ifds, ifde, jfds, jfde, & ! fire grid dimensions
479 ifms, ifme, jfms, jfme, &
480 ifts,ifte,jfts,jfte, &
481 ir,jr, & ! atm/fire grid ratio
482 zs, & ! atm grid arrays in
483 zsf) ! fire grid arrays out
484 else
485 write(msg,'(a,i3,a)')'fire_topo_from_atm=',fire_topo_from_atm,' assuming ZSF set, interpolation skipped'
486 endif
488 if(ignition_longlat .eq.0)then
489 ! set ideal fire mesh coordinates - used for ignition only
490 ! do not forget to set unit_fxlong, unit_fxlat outside of parallel loop
491 call set_ideal_coord( dxf,dyf, &
492 ifds,ifde,jfds,jfde, &
493 ifms,ifme,jfms,jfme, &
494 ifts,ifte,jfts,jfte, &
495 fxlong,fxlat )
496 else
497 ! assume halo xlong xlat
498 ! interpolate nodal coordinates
500 #ifdef DEBUG_OUT
501 call write_array_m(its,ite,jts,jte,ims,ime,jms,jme,xlat,'xlat',id)
502 call write_array_m(its,ite,jts,jte,ims,ime,jms,jme,xlong,'xlong',id)
503 #endif
504 call interpolate_z2fire(id, & ! for debug output, <= 0 no output
505 ids,ide, jds,jde, & ! atm grid dimensions
506 ims,ime, jms,jme, &
507 ips,ipe,jps,jpe, &
508 its,ite,jts,jte, &
509 ifds, ifde, jfds, jfde, & ! fire grid dimensions
510 ifms, ifme, jfms, jfme, &
511 ifts,ifte,jfts,jfte, &
512 ir,jr, & ! atm/fire grid ratio
513 xlat, & ! atm grid arrays in
514 fxlat) ! fire grid arrays out
516 call interpolate_z2fire(id, & ! for debug output, <= 0 no output
517 ids,ide, jds,jde, & ! atm grid dimensions
518 ims,ime, jms,jme, &
519 ips,ipe,jps,jpe, &
520 its,ite,jts,jte, &
521 ifds, ifde, jfds, jfde, & ! fire grid dimensions
522 ifms, ifme, jfms, jfme, &
523 ifts,ifte,jfts,jfte, &
524 ir,jr, & ! atm/fire grid ratio
525 xlong, & ! atm grid arrays in
526 fxlong) ! fire grid arrays out
528 endif
530 elseif(ifun.eq.2)then
532 ! after the loop where zsf created exited and all synced
533 call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,zsf,'driver_phys:zsf')
534 elseif(ifun.eq.3)then ! interpolate winds to the fire grid
536 call interpolate_atm2fire(id, & ! flag for debug output
537 ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
538 ims,ime, kms,kme, jms,jme, &
539 ips,ipe,jps,jpe, &
540 its,ite,jts,jte, &
541 ifds, ifde, jfds, jfde, & ! fire grid dimensions
542 ifms, ifme, jfms, jfme, &
543 ifts,ifte,jfts,jfte, &
544 ir,jr, & ! atm/fire grid ratio
545 u_frame, v_frame, & ! velocity frame correction
546 u,v, & ! atm grid arrays in
547 uf,vf) ! fire grid arrays out
549 endif
551 call sfire_model (id,ifun,need_lfn_update, &
552 num_ignitions, & ! switches
553 ifuelread,nfuel_cat0, & ! initialize fuel categories
554 ifds,ifde,jfds,jfde, & ! fire domain dims
555 ifms,ifme,jfms,jfme, & ! fire memory dims
556 ifps,ifpe,jfps,jfpe, &
557 ifts,ifte,jfts,jfte, & ! fire patch dims
558 time_start,dt, & ! time and increment
559 dxf,dyf, & ! fire mesh spacing
560 ignition_start_x,ignition_start_y, & ! ignition - small arrays
561 ignition_end_x,ignition_end_y, &
562 ignition_radius, &
563 ignition_time, &
564 fxlong,fxlat,unit_fxlong,unit_fxlat, & ! fire mesh coordinates
565 zsf, & ! terrain height (for gradient)
566 uf,vf, & ! input: wind
567 lfn,lfn_out,tign,fuel_frac, & ! state: level function, ign time, fuel left
568 fire_area, & ! output: fraction of cell burning
569 fgrnhfx,fgrnqfx, & ! output: heat fluxes
570 nfuel_cat, & ! fuel data per point
571 fuel_time, & ! save derived internal data
572 bbb,betafl,phiwc,r_0,fgip,ischap &
573 )
575 if(ifun.eq.6)then ! heat fluxes into the atmosphere
577 call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,fgrnhfx,'fire_driver:fgrnhfx')
578 call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,fgrnqfx,'fire_driver:fgrnqfx')
580 ! sum the fluxes over atm cells
581 call sum_2d_cells( &
582 ifms,ifme,jfms,jfme, &
583 ifts,ifte,jfts,jfte, &
584 fgrnhfx, &
585 ims, ime, jms, jme, &
586 its,ite,jts,jte, &
587 grnhfx)
588 !comment out the next call to get results as before commit 55fd92051196b796891b60cb7ec1c4bdb8800078
589 call sum_2d_cells( &
590 ifms,ifme,jfms,jfme, &
591 ifts,ifte,jfts,jfte, &
592 fgrnqfx, &
593 ims, ime, jms, jme, &
594 its,ite,jts,jte, &
595 grnqfx)
597 write(msg,'(a,f6.3)')'fire-atmosphere feedback scaling ',fire_atm_feedback
598 do j=jts,jte
599 do i=its,ite
600 ! scale ground fluxes to get the averages
601 grnhfx(i,j)=fire_atm_feedback*grnhfx(i,j)/(ir*jr)
602 grnqfx(i,j)=fire_atm_feedback*grnqfx(i,j)/(ir*jr)
603 ! we do not have canopy fluxes yet...
604 canhfx(i,j)=0
605 canqfx(i,j)=0
606 enddo
607 enddo
609 do j=jts,jte
610 do k=kts,min(kte+1,kde)
611 do i=its,ite
612 rthfrten(i,k,j)=0.
613 rqvfrten(i,k,j)=0.
614 enddo
615 enddo
616 enddo
619 ! --- add heat and moisture fluxes to tendency variables by postulated decay
621 call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme,grnhfx,'fire_driver:grnhfx')
622 call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme,grnqfx,'fire_driver:grnqfx')
624 call fire_tendency( &
625 ids,ide, kds,kde, jds,jde, & ! dimensions
626 ims,ime, kms,kme, jms,jme, &
627 its,ite, kts,kte, jts,jte, & !
628 grnhfx,grnqfx,canhfx,canqfx, & ! fluxes on atm grid
629 fire_ext_grnd,fire_ext_crwn,fire_crwn_hgt, &
630 zs,z_at_w,dz8w,mu,rho, &
631 rthfrten,rqvfrten) ! out
633 ! debug print to compare
635 call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,rthfrten,'fire_driver_phys:rthfrten')
636 call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,rqvfrten,'fire_driver_phys:rqvfrten')
639 endif ! ifun=6
641 enddo ! tiles
642 !$OMP END PARALLEL DO
644 #ifdef DEBUG_OUT
645 if(ifun.eq.1)then
646 if(pid.ne.0)then
647 call write_array_m(ips,ipe,jps,jpe,ims,ime,jms,jme,zs,'zs',pid)
648 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,zsf,'zsf',pid)
649 endif
650 #endif
651 elseif(ifun.eq.3)then
652 #ifdef DEBUG_OUT
653 if(pid.gt.0)then
654 call write_array_m3(ips,ipe+1,kds,kds+1,jps,jpe+1,ims,ime,kms,kme,jms,jme,u,'u',pid)
655 call write_array_m3(ips,ipe+1,kds,kds+1,jps,jpe+1,ims,ime,kms,kme,jms,jme,v,'v',pid)
656 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,uf,'uf',pid)
657 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,vf,'vf',pid)
658 endif
659 #endif
660 elseif(ifun.eq.5)then
661 #ifdef DEBUG_OUT
662 if(pid.gt.0)then
663 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,lfn,'lfn',pid)
664 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,tign,'tign',pid)
665 endif
666 #endif
667 elseif(ifun.eq.6)then
668 #ifdef DEBUG_OUT
669 if(pid.gt.0)then
670 call write_array_m(ips,ipe,jps,jpe,ims,ime,jms,jme,grnhfx,'grnhfx',pid)
671 call write_array_m(ips,ipe,jps,jpe,ims,ime,jms,jme,grnqfx,'grnqfx',pid)
672 call write_array_m3(ips,ipe,kps,kpe,jps,jpe,ims,ime,kms,kme,jms,jme,rthfrten,'rthfrten',pid)
673 call write_array_m3(ips,ipe,kps,kpe,jps,jpe,ims,ime,kms,kme,jms,jme,rqvfrten,'rqvfrten',pid)
674 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,fuel_frac,'fuel_frac',pid)
675 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,fgrnhfx,'fgrnhfx',pid)
676 call write_array_m(ifps,ifpe,jfps,jfpe,ifms,ifme,jfms,jfme,fgrnqfx,'fgrnqfx',pid)
677 endif
678 #endif
679 !call print_2d_stats(ips,ipe,jps,jpe,ims,ime,jms,jme,mu,'driver:mu')
680 !call print_3d_stats(ips,ipe,kps,kpe,jps,jpe,ims,ime,kms,kme,jms,jme,rho,'driver:rho')
681 kpe1=min(kps+1,kpe)
682 !kpe1=kps-1
683 do k=kts,min(kte,kts+3)
684 write(kk,'(i2)')k
685 call print_3d_stats(ips,ipe,k,k,jps,jpe,ims,ime,kms,kme,jms,jme,rthfrten,kk//'driver_phys:rthfrten')
686 call print_3d_stats(ips,ipe,k,k,jps,jpe,ims,ime,kms,kme,jms,jme,rqvfrten,kk//'driver_phys:rqvfrten')
687 enddo
688 endif
690 end subroutine sfire_driver_phys
691 !
692 !*******************
693 !
695 subroutine fire_ignition_convert (config_flags,fire_max_ignitions,ignition_longlat, &
696 fire_ignition_start_x,fire_ignition_start_y,fire_ignition_end_x,fire_ignition_end_y, &
697 fire_ignition_radius,fire_ignition_time,fire_num_ignitions)
698 USE module_configure
699 implicit none
700 !*** arguments
701 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
702 integer, intent(in)::fire_max_ignitions
703 real, dimension(fire_max_ignitions), intent(out):: &
704 fire_ignition_start_x,fire_ignition_start_y,fire_ignition_end_x,fire_ignition_end_y, &
705 fire_ignition_radius,fire_ignition_time
706 integer, intent(out)::fire_num_ignitions,ignition_longlat
707 !*** local
708 integer::i
709 logical:: real,ideal
710 !*** executable
711 ! this is only until I figure out how to input arrays through the namelist...
712 if(fire_max_ignitions.lt.5)call crash('fire_max_ignitions too small')
713 ! figure out which kind of coordinates from the first given
714 ideal=config_flags%fire_ignition_start_x1 .ne.0. .or. config_flags%fire_ignition_start_y1 .ne. 0.
715 real=config_flags%fire_ignition_start_long1 .ne. 0. .or. config_flags%fire_ignition_start_lat1 .ne. 0.
716 if(ideal)call message('Using ideal ignition coordinates, m from the lower left domain corner')
717 if(real)call message('Using real ignition coordinates, longitude and latitude')
718 if(ideal.and.real)call crash('Only one of the ideal or real coordinates may be given')
719 if(ideal)then
720 ! use values from _x and _y variables
721 ignition_longlat=0
722 fire_ignition_start_x(1)=config_flags%fire_ignition_start_x1
723 fire_ignition_start_y(1)=config_flags%fire_ignition_start_y1
724 fire_ignition_end_x(1)=config_flags%fire_ignition_end_x1
725 fire_ignition_end_y(1)=config_flags%fire_ignition_end_y1
726 fire_ignition_start_x(2)=config_flags%fire_ignition_start_x2
727 fire_ignition_start_y(2)=config_flags%fire_ignition_start_y2
728 fire_ignition_end_x(2)=config_flags%fire_ignition_end_x2
729 fire_ignition_end_y(2)=config_flags%fire_ignition_end_y2
730 fire_ignition_start_x(3)=config_flags%fire_ignition_start_x3
731 fire_ignition_start_y(3)=config_flags%fire_ignition_start_y3
732 fire_ignition_end_x(3)=config_flags%fire_ignition_end_x3
733 fire_ignition_end_y(3)=config_flags%fire_ignition_end_y3
734 fire_ignition_start_x(4)=config_flags%fire_ignition_start_x4
735 fire_ignition_start_y(4)=config_flags%fire_ignition_start_y4
736 fire_ignition_end_x(4)=config_flags%fire_ignition_end_x4
737 fire_ignition_end_y(4)=config_flags%fire_ignition_end_y4
738 fire_ignition_start_x(5)=config_flags%fire_ignition_start_x5
739 fire_ignition_start_y(5)=config_flags%fire_ignition_start_y5
740 fire_ignition_end_x(5)=config_flags%fire_ignition_end_x3
741 fire_ignition_end_y(5)=config_flags%fire_ignition_end_y3
742 endif
743 if(real)then
744 ! use values from _long and _lat
745 ignition_longlat=1
746 fire_ignition_start_x(1)=config_flags%fire_ignition_start_long1
747 fire_ignition_start_y(1)=config_flags%fire_ignition_start_lat1
748 fire_ignition_end_x(1)=config_flags%fire_ignition_end_long1
749 fire_ignition_end_y(1)=config_flags%fire_ignition_end_lat1
750 fire_ignition_start_x(2)=config_flags%fire_ignition_start_long2
751 fire_ignition_start_y(2)=config_flags%fire_ignition_start_lat2
752 fire_ignition_end_x(2)=config_flags%fire_ignition_end_long2
753 fire_ignition_end_y(2)=config_flags%fire_ignition_end_lat2
754 fire_ignition_start_x(3)=config_flags%fire_ignition_start_long3
755 fire_ignition_start_y(3)=config_flags%fire_ignition_start_lat3
756 fire_ignition_end_x(3)=config_flags%fire_ignition_end_long3
757 fire_ignition_end_y(3)=config_flags%fire_ignition_end_lat3
758 fire_ignition_start_x(4)=config_flags%fire_ignition_start_long4
759 fire_ignition_start_y(4)=config_flags%fire_ignition_start_lat4
760 fire_ignition_end_x(4)=config_flags%fire_ignition_end_long4
761 fire_ignition_end_y(4)=config_flags%fire_ignition_end_lat4
762 fire_ignition_start_x(5)=config_flags%fire_ignition_start_long5
763 fire_ignition_start_y(5)=config_flags%fire_ignition_start_lat5
764 fire_ignition_end_x(5)=config_flags%fire_ignition_end_long3
765 fire_ignition_end_y(5)=config_flags%fire_ignition_end_lat3
766 endif
767 ! common to both cases
768 fire_ignition_radius(1)=config_flags%fire_ignition_radius1
769 fire_ignition_time(1)=config_flags%fire_ignition_time1
770 fire_ignition_radius(2)=config_flags%fire_ignition_radius2
771 fire_ignition_time(2)=config_flags%fire_ignition_time2
772 fire_ignition_radius(3)=config_flags%fire_ignition_radius3
773 fire_ignition_time(3)=config_flags%fire_ignition_time3
774 fire_ignition_radius(4)=config_flags%fire_ignition_radius4
775 fire_ignition_time(4)=config_flags%fire_ignition_time4
776 fire_ignition_radius(5)=config_flags%fire_ignition_radius5
777 fire_ignition_time(5)=config_flags%fire_ignition_time5
779 !
780 fire_num_ignitions=0
781 do i=1,min(5,config_flags%fire_num_ignitions)
782 ! count the ignitions
783 if(fire_ignition_radius(i).gt.0.)fire_num_ignitions=i
784 ! expand the point ignitions given as zero
785 if(fire_ignition_end_x(i).eq.0.)fire_ignition_end_x(i)=fire_ignition_start_x(i)
786 if(fire_ignition_end_y(i).eq.0.)fire_ignition_end_y(i)=fire_ignition_start_y(i)
787 enddo
789 end subroutine fire_ignition_convert
791 !
792 !*****************************
793 !
794 !module_fr_sfire_driver%%interpolate_atm2fire
796 subroutine interpolate_atm2fire(id, & ! for debug output, <= 0 no output
797 ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
798 ims,ime, kms,kme, jms,jme, &
799 ips,ipe,jps,jpe, &
800 its,ite,jts,jte, &
801 ifds, ifde, jfds, jfde, & ! fire grid dimensions
802 ifms, ifme, jfms, jfme, &
803 ifts,ifte,jfts,jfte, &
804 ir,jr, & ! atm/fire grid ratio
805 u_frame, v_frame, & ! velocity frame correction
806 u,v, & ! atm grid arrays in
807 uf,vf) ! fire grid arrays out
809 implicit none
810 !*** purpose: interpolate winds and height
812 !*** arguments
813 integer, intent(in)::id, &
814 ids,ide, kds,kde, jds,jde, & ! atm domain bounds
815 ims,ime, kms,kme, jms,jme, & ! atm memory bounds
816 ips,ipe,jps,jpe, &
817 its,ite,jts,jte, & ! atm tile bounds
818 ifds, ifde, jfds, jfde, & ! fire domain bounds
819 ifms, ifme, jfms, jfme, & ! fire memory bounds
820 ifts,ifte,jfts,jfte, & ! fire tile bounds
821 ir,jr ! atm/fire grid refinement ratio
822 real, intent(in):: u_frame, v_frame ! velocity frame correction
823 real,intent(in),dimension(ims:ime,kms:kme,jms:jme)::&
824 u,v ! atm wind velocity, staggered
825 real,intent(out), dimension(ifms:ifme,jfms:jfme)::&
826 uf,vf ! wind velocity fire grid nodes
829 !*** local
830 #define TDIMS its-1,ite+2,jts-1,jte+2
831 real, dimension(its-1:ite+2,jts-1:jte+2):: ua,va ! atm winds, averaged over height
832 integer:: i,j,k,ifts1,ifte1,jfts1,jfte1
834 !*** executable
836 k=kds ! the ground
837 do j = jts-1,jte+2
838 do i = its-1,ite+2
839 ! average 1st 2 layers, correct const shift
840 ua(i,j)=0.5*( u(i,k,j) + u(i,k+1,j)) + u_frame
841 va(i,j)=0.5*( v(i,k,j) + v(i,k+1,j)) + v_frame
842 enddo
843 enddo
845 ! extend the winds by one beyond the domain boundary
846 call continue_at_boundary(1,0,0., & ! do x direction or y direction
847 TDIMS, & ! memory dims
848 ids,ide+1,jds,jde+1, & ! domain dims - winds defined up to +1
849 ips,ipe+1,jps,jpe+1, & ! patch dims - winds defined up to +1
850 its,ite+1,jts,jte+1, & ! tile dims
851 va) ! array
853 call continue_at_boundary(0,1,0., & ! do x direction or y direction
854 TDIMS, & ! memory dims
855 ids,ide+1,jds,jde+1, & ! domain dims - winds defined up to +1
856 ips,ipe+1,jps,jpe+1, & ! patch dims - winds defined up to +1
857 its,ite+1,jts,jte+1, & ! tile dims
858 ua) ! array
860 !if (id.gt.0) then
861 ! call write_array_m(TDIMS,TDIMS,ua,'ua',id)
862 ! call write_array_m(TDIMS,TDIMS,va,'va',id)
863 !endif
865 call print_2d_stats_vec(its,ite+1,jts,jte+1,TDIMS,ua,va, &
866 'driver: atm wind (m/s)')
869 ! ---------------
870 ! | F | F | F | F | Example of atmospheric and fire grid with
871 ! |-------|-------| ir=jr=4.
872 ! | F | F | F | F | Winds are given at the midpoints of the sides of the coarse grid,
873 ! u-------z-------| interpolated to midpoints of the cells of the fine fire grid F.
874 ! | F | F | F | F |
875 ! |---------------|
876 ! | * | F | F | F |
877 ! -------v-------
878 !
879 ! Meshes are aligned by the lower left cell of the domain. Then in the above figure
880 ! u = node with the ua component of the wind at (ids,jds), midpoint of side
881 ! v = node with the va component of the wind at (ids,jds), midpoint of side
882 ! * = fire grid node at (ifds,jfds)
883 ! z = node with height, midpoint of cell
884 !
885 ! ua(ids,jds)=uf(ifds-0.5,jfds+jr/2+0.5)
886 ! va(ids,jds)=vf(ifds+ir/2+0.5,jfds-0.5)
887 ! za(ids,jds)=zsf(ifds+ir/2+0.5,jfds+jr/2+0.5)
889 ifts1=snode(ifts,ifds,-1) ! go 1 beyond domain boundary but not between tiles
890 ifte1=snode(ifte,ifde,+1)
891 jfts1=snode(jfts,jfds,-1)
892 jfte1=snode(jfte,jfde,+1)
894 call interpolate_2d( &
895 TDIMS, & ! memory dims atm grid tile
896 TDIMS, & ! where atm grid values set
897 ifms,ifme,jfms,jfme, & ! array dims fire grid
898 ifts1,ifte1,jfts1,jfte1,& ! dimensions on the fire grid to interpolate to
899 ir,jr, & ! refinement ratio
900 real(ids),real(jds),ifds-.5,jfds+(jr+1)*.5, & ! line up by lower left corner of domain
901 ua, & ! in atm grid
902 uf) ! out fire grid
904 call interpolate_2d( &
905 TDIMS, & ! memory dims atm grid tile
906 TDIMS, & ! where atm grid values set
907 ifms,ifme,jfms,jfme, & ! array dims fire grid
908 ifts1,ifte1,jfts1,jfte1,& ! dimensions on the fire grid to interpolate to
909 ir,jr, & ! refinement ratio
910 real(ids),real(jds),ifds+(ir+1)*.5,jfds-0.5, & ! line up by lower left corner of domain
911 va, & ! in atm grid
912 vf) ! out fire grid
914 !call print_2d_stats_vec(ifts-1,ifte+1,jfts-1,jfte+1,ifms,ifme,jfms,jfme,uf,vf,'fire wind (m/s)')
917 end subroutine interpolate_atm2fire
919 !
920 !*****************************
921 !
923 subroutine interpolate_z2fire(id, & ! for debug output, <= 0 no output
924 ids,ide, jds,jde, & ! atm grid dimensions
925 ims,ime, jms,jme, &
926 ips,ipe,jps,jpe, &
927 its,ite,jts,jte, &
928 ifds, ifde, jfds, jfde, & ! fire grid dimensions
929 ifms, ifme, jfms, jfme, &
930 ifts,ifte,jfts,jfte, &
931 ir,jr, & ! atm/fire grid ratio
932 zs, & ! atm grid arrays in
933 zsf) ! fire grid arrays out
935 implicit none
936 !*** purpose: interpolate height
938 !*** arguments
939 integer, intent(in)::id, &
940 ids,ide, jds,jde, & ! atm domain bounds
941 ims,ime,jms,jme, & ! atm memory bounds
942 ips,ipe,jps,jpe, &
943 its,ite,jts,jte, & ! atm tile bounds
944 ifds, ifde, jfds, jfde, & ! fire domain bounds
945 ifms, ifme, jfms, jfme, & ! fire memory bounds
946 ifts,ifte,jfts,jfte, & ! fire tile bounds
947 ir,jr ! atm/fire grid refinement ratio
948 real, intent(in), dimension(ims:ime, jms:jme):: zs ! terrain height at atm cell centers & ! terrain height
949 real,intent(out), dimension(ifms:ifme,jfms:jfme)::&
950 zsf ! terrain height fire grid nodes
953 !*** local
954 real, dimension(its-2:ite+2,jts-2:jte+2):: za ! terrain height
955 integer:: i,j,jts1,jte1,its1,ite1,jfts1,jfte1,ifts1,ifte1
957 ! terrain height
959 jts1=max(jts-1,jds) ! lower loop limit by one less when at end of domain
960 its1=max(its-1,ids) ! ASSUMES THE HALO IS THERE if patch != domain
961 jte1=min(jte+1,jde)
962 ite1=min(ite+1,ide)
963 do j = jts1,jte1
964 do i = its1,ite1
965 ! copy to local array
966 za(i,j)=zs(i,j)
967 enddo
968 enddo
970 call continue_at_boundary(1,1,0., & ! do x direction or y direction
971 its-2,ite+2,jts-2,jte+2, & ! memory dims
972 ids,ide,jds,jde, & ! domain dims - winds defined up to +1
973 ips,ipe,jps,jpe, & ! patch dims - winds defined up to +1
974 its1,ite1,jts1,jte1, & ! tile dims
975 za) ! array
977 ! interpolate to tile plus strip along domain boundary if at boundary
978 jfts1=snode(jfts,jfds,-1) ! lower loop limit by one less when at end of domain
979 ifts1=snode(ifts,ifds,-1)
980 jfte1=snode(jfte,jfde,+1)
981 ifte1=snode(ifte,ifde,+1)
983 call interpolate_2d( &
984 its-2,ite+2,jts-2,jte+2, & ! memory dims atm grid tile
985 its1-1,ite1+1,jts1-1,jte1+1, & ! where atm grid values set
986 ifms,ifme,jfms,jfme, & ! array dims fire grid
987 ifts1,ifte1,jfts1,jfte1, & ! dimensions fire grid tile
988 ir,jr, & ! refinement ratio
989 real(ids),real(jds),ifds+(ir+1)*.5,jfds+(jr+1)*.5, & ! line up by lower left corner of domain
990 za, & ! in atm grid
991 zsf) ! out fire grid
993 end subroutine interpolate_z2fire
994 !
995 !*****************************
996 !
998 subroutine check_fmesh(ids,ide,ifds,ifde,ir,s)
999 !*** purpose: check if fire and atm meshes line up
1000 implicit none
1001 !*** arguments
1002 integer, intent(in)::ids,ide,ifds,ifde,ir
1003 character(len=*),intent(in)::s
1004 !*** local
1005 character(len=128)msg
1006 !*** executable
1007 if ((ide-ids+1)*ir.ne.(ifde-ifds+1))then
1008 write(msg,1)s,ids,ide,ifds,ifde,ir
1009 1 format('module_fr_sfire_driver: incompatible bounds ',a,' atm ',i5,':',i5,' fire ',i5,':',i5,' ratio ',i3)
1010 call crash(msg)
1011 endif
1012 end subroutine check_fmesh
1014 !
1015 !*****************************
1016 !
1017 subroutine set_flags(config_flags)
1018 USE module_configure
1019 use module_fr_sfire_util
1020 implicit none
1021 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1022 ! copy flags from wrf to module_fr_sfire_util
1023 ! for instructions how to add a flag see the top of module_fr_sfire_util.F
1026 fire_print_msg = config_flags%fire_print_msg
1027 fire_print_file = config_flags%fire_print_file
1028 fuel_left_method = config_flags%fire_fuel_left_method
1029 fuel_left_irl = config_flags%fire_fuel_left_irl
1030 fuel_left_jrl = config_flags%fire_fuel_left_jrl
1031 fire_atm_feedback = config_flags%fire_atm_feedback
1032 boundary_guard = config_flags%fire_boundary_guard
1033 fire_back_weight = config_flags%fire_back_weight
1034 fire_grows_only = config_flags%fire_grows_only
1035 fire_upwinding = config_flags%fire_upwinding
1036 fire_upwind_split = config_flags%fire_upwind_split
1037 fire_viscosity = config_flags%fire_viscosity
1038 fire_lfn_ext_up = config_flags%fire_lfn_ext_up
1039 fire_test_steps = config_flags%fire_test_steps
1040 fire_topo_from_atm = config_flags%fire_topo_from_atm
1045 end subroutine set_flags
1047 subroutine print_id
1048 character(len=128)::id,msg
1049 !#include "sfire_id.inc"
1050 id='5ef422698db930faf5f742c098480859b7b24790'
1051 msg='version '//id
1052 call message(msg)
1053 end subroutine print_id
1055 end module module_fr_sfire_driver