Skip to content

Commit

Permalink
fixing, redoing logic when to run the moisture model
Browse files Browse the repository at this point in the history
  • Loading branch information
@janmandel
janmandel committed Feb 28, 2012
1 parent 2694706 commit d0b6d5e
Show file tree
Hide file tree
Showing 3 changed files with 81 additions and 48 deletions.
80 changes: 43 additions & 37 deletions wrfv2_fire/phys/module_fr_sfire_driver.F
View file
Expand Up @@ -175,50 +175,54 @@ subroutine sfire_driver_em ( grid , config_flags &
fmoist_interp = config_flags%fmoist_interp

!decide what to run
moisture_time = time_step_start
run_advance_moisture = .false. ! default
run_fuel_moisture = .false. ! default
moisture_initializing = fire_ifun_start < 3



if(fmoist_run)then
if(moisture_initializing)then
call message('initialization, moisture model will run')
run_advance_moisture=.true.
grid%fmoist_lasttime=0. ! initialize the last time the model has run to start of run
elseif(config_flags%fmoist_freq > 0)then ! regular timestep. go by multiples?
if(mod(grid%itimestep,config_flags%fmoist_freq) .eq. 0)then
write(msg,'(a,i10,a,i10)')'moisture model runs because timestep ',grid%itimestep,' is a multiple of ',config_flags%fmoist_freq
call message(msg)
run_advance_moisture = .true.
if(fire_ifun_end>2)call crash('initialization must be run separately')
grid%fmoist_lasttime=moisture_time ! initialize the last time the model has run to start of run
grid%fmoist_nexttime=moisture_time
call message('moisture initialization')
run_advance_moisture = .true.
else ! regular timestep
if(config_flags%fmoist_freq > 0)then ! regular timestep. go by multiples?
if(mod(grid%itimestep,config_flags%fmoist_freq) .eq. 0)then
write(msg,'(a,i10,a,i10)')'moisture model runs because timestep ',grid%itimestep,' is a multiple of ',config_flags%fmoist_freq
call message(msg)
run_advance_moisture = .true.
endif
else
if(.not. moisture_time < grid%fmoist_nexttime) then ! no, by time interval
write(msg,'(a,f12.2,a)')'moisture model runs because time ',grid%fmoist_nexttime,'s has arrived'
call message(msg)
run_advance_moisture = .true.
endif
endif
else
if(.not. moisture_time < grid%fmoist_nexttime) then ! no, by time interval
write(msg,'(a,f12.2,a)')'moisture model runs because time ',grid%fmoist_nexttime,'s has arrived'
call message(msg)
run_advance_moisture = .true.
if(run_advance_moisture)then ! decide on timing
dt_moisture = moisture_time - grid%fmoist_lasttime ! Time since moisture model run the last time. Should be long.
grid%fmoist_lasttime = moisture_time
if(config_flags%fmoist_freq > 0)then
write(msg,'(a,f12.2,a,i10,a)')'moisture time step is ',dt_moisture,'s running every ',config_flags%fmoist_freq,' steps'
call message(msg)
else
grid%fmoist_nexttime = moisture_time + config_flags%fmoist_dt
write(msg,'(a,f12.2,a,f12.2,a)')'moisture time step is ',dt_moisture,'s next run at ',grid%fmoist_nexttime,'s'
call message(msg)
endif
if(fmoist_interp)then
call message('moisture interpolation to fuels will run because moisture model does')
run_fuel_moisture=.true.
endif
endif
endif
endif
if(fmoist_interp)then
if(run_advance_moisture)then
call message('moisture interpolation to fuels will run because moisture model does')
elseif(itimestep.eq.1.and.fmoist_interp)then
call message('initializing, moisture interpolation to fuels will run from input data')
run_fuel_moisture=.true.
elseif(moisture_initializing)then
call message('initaizing, moisture interpolation to fuels will run from input data')
endif
endif

if(run_advance_moisture)then ! decide on timing
moisture_time = time_step_start
dt_moisture = moisture_time - grid%fmoist_lasttime ! Time since moisture model run the last time. Should be long.
grid%fmoist_lasttime = moisture_time
if(config_flags%fmoist_freq > 0)then
write(msg,'(a,f12.2,a,i10,a)')'moisture time step is ',dt_moisture,'s running every ',config_flags%fmoist_freq,' steps'
call message(msg)
else
grid%fmoist_nexttime = moisture_time + config_flags%fmoist_dt
write(msg,'(a,f12.2,a,f12.2,a)')'moisture time step is ',dt_moisture,'s next run at ',grid%fmoist_nexttime,'s'
call message(msg)
endif
endif

!$OMP CRITICAL(SFIRE_DRIVER_CRIT)
Expand Down Expand Up @@ -705,6 +709,7 @@ subroutine sfire_driver_phys (ifun, &
fmc_gc & ! fuel moisture fields updated, by class, assumed set to something reasonable
)
endif
call print_3d_stats_by_slice(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'initial fmc_gc')
call advance_moisture( &
.true., & ! initialize timestepping
ims,ime, jms,jme, & ! memory dimensions
Expand All @@ -717,7 +722,7 @@ subroutine sfire_driver_phys (ifun, &
t2_old, q2_old, psfc_old, & ! previous values of the atmospheric state at surface
fmc_gc & ! fuel moisture fields updated, by class, assumed set to something reasonable
)
call print_3d_stats(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'driver_phys: fmc_gc')
call print_3d_stats_by_slice(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'after advance: fmc_gc')
endif

elseif(ifun.eq.3)then ! interpolate winds to the fire grid
Expand Down Expand Up @@ -787,7 +792,7 @@ subroutine sfire_driver_phys (ifun, &

! one timestep of the moisture model
if(run_advance_moisture)then
call print_3d_stats(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'driver_phys:fmc_gc')
call print_3d_stats_by_slice(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'before advance fmc_gc')
call advance_moisture( &
.false., &
ims,ime, jms,jme, & ! memory dimensions
Expand All @@ -800,12 +805,13 @@ subroutine sfire_driver_phys (ifun, &
t2_old, q2_old, psfc_old, & ! previous values of the atmospheric state at surface
fmc_gc & ! fuel moisture fields updated, by class, assumed set to something reasonable
)
call print_3d_stats(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'fmc_gc')
call print_3d_stats_by_slice(its,ite,1,moisture_classes,jts,jte,ims,ime,1,nfmc,jms,jme,fmc_gc,'after advance fmc_gc')
endif

elseif(ifun.eq.4)then

! interpolate and compute weighted average to get the fuel moisture
!! print *,'ifun=4, run_fuel_moisture=',run_fuel_moisture
if(run_fuel_moisture)then
call fuel_moisture( &
id, & ! for prints and maybe file names
Expand Down
29 changes: 18 additions & 11 deletions wrfv2_fire/phys/module_fr_sfire_phys.F
View file
Expand Up @@ -254,9 +254,10 @@ subroutine fuel_moisture( &
real,intent(out),dimension(ifms:ifme,jfms:jfme):: fmc_g ! fuel data

!**** local
real, dimension(its-1:its+1,jts-1:jts+1):: fmc_k ! copy of fmc_gc(:,k,:)
real, dimension(its-1:ite+1,jts-1:jte+1):: fmc_k ! copy of fmc_gc(:,k,:)
real, dimension(ifts:ifte,jfts:jfte):: fmc_f ! interpolation of fmc_gc(:,k,:) to the fire grid
integer::i,j,k,n
integer::ibs,ibe,jbs,jbe


do j=jfts,jfte
Expand All @@ -265,15 +266,22 @@ subroutine fuel_moisture( &
enddo
enddo

do k=1,nfmc
! one beyond the tile but not beyond the domain boundary
ibs=max(jds,jts-1)
ibe=min(jde,jte+1)
jbs=max(ids,its-1)
jbe=min(ide,ite+1)

do j=jts-1,jts+1
do i=its-1,its+1
do k=1,moisture_classes

! copy halo beyond the tile but not beyond the domain boundary
do j=jbs,jbe
do i=ibs,ibe
fmc_k(i,j)=fmc_gc(i,k,j) ! copy slice to 2d array
enddo
enddo

call print_2d_stats(its,ite,jts,jte,its-1,ite+1,jts-1,jte+1,fmc_k,'advance_moisture: class fmc_k')
call print_2d_stats(ibs,ibe,jbs,jbe,its-1,ite+1,jts-1,jte+1,fmc_k,'fuel_moisture: fmc_k')

! interpolate moisture contents in the class k to the fire mesh
call interpolate_z2fire(id,0, & ! for debug output, <= 0 no output
Expand All @@ -288,7 +296,7 @@ subroutine fuel_moisture( &
fmc_k, & ! atm grid arrays in
fmc_f) ! fire grid arrays out

call print_2d_stats(ifts,ifte,jfts,jfte,ifts,ifte,jfts,jfte,fmc_f,'advance_moisture: interpolated to fire mesh, fmc_f')
call print_2d_stats(ifts,ifte,jfts,jfte,ifts,ifte,jfts,jfte,fmc_f,'fuel_moisture: fmc_f')

! add moisture contents for class k to the fuel moisture
do j=jfts,jfte
Expand All @@ -300,7 +308,7 @@ subroutine fuel_moisture( &
enddo
enddo

call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,fmc_g,'advance_moisture: fire mesh sum fmc_g')
call print_2d_stats(ifts,ifte,jfts,jfte,ifms,ifme,jfms,jfme,fmc_g,'fuel_moisture: fmc_g')

enddo

Expand Down Expand Up @@ -331,6 +339,7 @@ subroutine initialize_moisture_classes( &
enddo
enddo
enddo
call message('moisture contents in all classes initialized from namelist.fire')
end subroutine initialize_moisture_classes

subroutine advance_moisture( &
Expand Down Expand Up @@ -367,7 +376,7 @@ subroutine advance_moisture( &

if(msglevel>1)then
!$OMP CRITICAL(SFIRE_PHYS_CRIT)
write(msg,*)'advance moisture: using ',moisture_classes,' moisture classes from available ',nfmc
write(msg,'(a,f10.2,a,i4,a,i4)')'advance moisture dt=',moisture_dt,'s using ',moisture_classes,' classes from possible ',nfmc
!$OMP END CRITICAL(SFIRE_PHYS_CRIT)
call message(msg)
endif
Expand All @@ -379,9 +388,7 @@ subroutine advance_moisture( &
call crash(msg)
endif

if(initialize)then
call copy2old
endif
if(initialize) call copy2old

do j=jts,jte
do k=1,nfmc
Expand Down
20 changes: 20 additions & 0 deletions wrfv2_fire/phys/module_fr_sfire_util.F
View file
Expand Up @@ -1312,6 +1312,26 @@ subroutine print_stat_line(name,ips,ipe,jps,jpe,min_a,max_a,avg_a)
if(.not.avg_a.eq.avg_a)call crash('NaN detected')
end subroutine print_stat_line

subroutine print_3d_stats_by_slice(ips,ipe,kps,kpe,jps,jpe, &
ims,ime,kms,kme,jms,jme, &
a,name)
implicit none
integer, intent(in)::ips,ipe,jps,jpe,ims,ime,jms,jme,kms,kme,kps,kpe
real, intent(in)::a(ims:ime,kms:kme,jms:jme)
character(len=*),intent(in)::name
integer::k
character(len=128)::msg
do k=kps,kpe
! print 3d stats for each horizontal slice separately
!$OMP CRITICAL(SFIRE_UTIL_CRIT)
write(msg,'(i2,1x,a)')k,name
!$OMP END CRITICAL(SFIRE_UTIL_CRIT)
call print_3d_stats(ips,ipe,kps,kpe,jps,jpe, &
ims,ime,kms,kme,jms,jme, &
a,msg)
enddo
end subroutine print_3d_stats_by_slice


subroutine print_3d_stats(ips,ipe,kps,kpe,jps,jpe, &
ims,ime,kms,kme,jms,jme, &
Expand Down

0 comments on commit d0b6d5e

Please sign in to comment.