Skip to content

Commit

Permalink
consolidated ros warning messages
Browse files Browse the repository at this point in the history
  • Loading branch information
@janmandel
janmandel committed Nov 20, 2016
1 parent 4f506a6 commit 05a8b8c
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 17 deletions.
25 changes: 18 additions & 7 deletions wrfv2_fire/phys/module_fr_sfire_core.F
View file
Expand Up @@ -1712,7 +1712,7 @@ subroutine prop_ls( id, & ! for debug
integer::ihs2,ihe2,jhs2,jhe2
integer::i,j,its1,ite1,jts1,jte1,k,kk,id1
character(len=128)::msg
integer::nfirenodes,nfireline
integer::nfirenodes,nfireline,ierrx
real::sum_err,min_err,max_err,sum_aerr,min_aerr,max_aerr
! constants
Expand Down Expand Up @@ -1901,7 +1901,7 @@ subroutine prop_ls( id, & ! for debug
grady=(lfn_out(i,j+1)-lfn_out(i,j-1))/(2.0*dy)
grad2=sqrt(gradx*gradx+grady*grady)
aspeed = (lfn_in(i,j)-lfn_out(i,j))/(dt*max(grad2,rmin))
rr = speed_func(gradx,grady,dx,dy,i,j,fp)
rr = speed_func(gradx,grady,dx,dy,i,j,fp,ierrx,msg)
err=aspeed-rr
sum_err=sum_err+err
min_err=min(min_err,err)
Expand Down Expand Up @@ -2003,8 +2003,8 @@ subroutine tend_ls( id, &
real:: te,diffLx,diffLy,diffRx,diffRy, &
diffCx,diffCy,diff2x,diff2y,grad,rr, &
ros_back,ros_wind,ros_slope,advx,advy,scale,nvx,nvy,speed
integer::i,j,itso,iteo,jtso,jteo
character(len=128)msg
integer::i,j,itso,iteo,jtso,jteo,ierrx,nerr
character(len=128)msg,msg2
! constants
real, parameter:: eps=epsilon(0.0)
Expand Down Expand Up @@ -2038,6 +2038,7 @@ subroutine tend_ls( id, &
call write_array_m(ints-1,inte+1,jnts-1,jnte+1,lims,lime,ljms,ljme,lfn,'tend_lfn_in',id)
#endif
nerr=0
tbound=0
do j=jnts,jnte
do i=ints,inte
Expand Down Expand Up @@ -2084,7 +2085,7 @@ subroutine tend_ls( id, &
! get rate of spread from wind speed and slope
call fire_ros(ros_back,ros_wind,ros_slope, &
nvx,nvy,i,j,fp)
nvx,nvy,i,j,fp,ierrx,msg2)
rr=ros_back + ros_wind + ros_slope
if(fire_grows_only.gt.0)rr=max(rr,0.)
Expand All @@ -2107,6 +2108,14 @@ subroutine tend_ls( id, &
enddo
enddo
if(nerr>0)then
!$OMP CRITICAL(SFIRE_CORE_CRIT)
write(msg,'(a,i6,1x,a)')'tend_ls:',nerr,'messages in rate of spread computations. Last message:'
!$OMP END CRITICAL(SFIRE_CORE_CRIT)
call warning(msg)
call warning(msg2)
endif
call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme, ros,'tend_ls: ros')
call print_2d_stats(ints,inte,jnts,jnte,tims,time,tjms,tjme, &
tend,'tend_ls: tend out')
Expand Down Expand Up @@ -2197,7 +2206,7 @@ end function select_eno
!**************************
!
real function speed_func(diffCx,diffCy,dx,dy,i,j,fp)
real function speed_func(diffCx,diffCy,dx,dy,i,j,fp,ierrx,msg)
!*** purpose
! the level set method speed function
implicit none
Expand All @@ -2206,6 +2215,8 @@ real function speed_func(diffCx,diffCy,dx,dy,i,j,fp)
real, intent(in)::dx,dy ! x and y coordinates of the direction of propagation
integer, intent(in)::i,j ! indices of the node to compute the speed at
type(fire_params),intent(in)::fp
integer, intent(out)::ierrx
character(len=*), intent(out)::msg
!*** local
real::scale,nvx,nvy,r
real::ros_back , ros_wind , ros_slope
Expand All @@ -2219,7 +2230,7 @@ real function speed_func(diffCx,diffCy,dx,dy,i,j,fp)
! get rate of spread from wind speed and slope
call fire_ros(ros_back,ros_wind,ros_slope, &
nvx,nvy,i,j,fp)
nvx,nvy,i,j,fp,ierrx,msg)
r=ros_back + ros_wind + ros_slope
if(fire_grows_only.gt.0)r=max(r,0.)
Expand Down
32 changes: 22 additions & 10 deletions wrfv2_fire/phys/module_fr_sfire_phys.F
View file
Expand Up @@ -951,6 +951,8 @@ subroutine write_fuels_m(nsteps,maxwind,maxslope)
real, dimension(1:3,1:nsteps), target::vx,vy,zsf,dzdxf,dzdyf,bbb,phisc,phiwc,r_0,fgip,ischap,fmc_g,wind,nfuel_cat
real, dimension(1:3,1:nsteps)::fuel_time,ros,fwh,fz0
real::ros_back,ros_wind,ros_slope,propx,propy,r
integer::ierrx
character(len=128)::msg

if(.not.have_fuel_cats)call crash('write_fuels_m: fuel categories not yet set')

Expand Down Expand Up @@ -1046,7 +1048,7 @@ subroutine write_fuels_m(nsteps,maxwind,maxslope)
do j=1,nsteps
do i=1,3
call fire_ros(ros_back,ros_wind,ros_slope, &
propx,propy,i,j,fp)
propx,propy,i,j,fp,ierrx,msg)
ros(i,j)=ros_back+ros_wind+ros_slope
enddo
write(iounit,13)k,'wind',j,wind(1,j),'wind speed at 6.1m'
Expand Down Expand Up @@ -1392,14 +1394,17 @@ real function fire_rate_of_spread(propx, propy, i,j,fp)
real, intent(in)::propx, propy! direction, need not be normalized
integer, intent(in)::i,j ! node mesh coordinates
type(fire_params),intent(in)::fp
!*** local
real:: ros_back,ros_wind,ros_slope,nvx,nvy,scale,rr
integer::ierrx ! number of errors
character(len=128)::msg ! error message
!*** executable
scale=sqrt(propx*propx+propy*propy)
if (.not. scale > 0.) scale =1.
nvx=propx/scale
nvy=propy/scale
call fire_ros(ros_back,ros_wind,ros_slope, nvx,nvy,i,j,fp)
call fire_ros(ros_back,ros_wind,ros_slope, nvx,nvy,i,j,fp,ierrx,msg)
rr = ros_back+ros_wind+ros_slope
if(fire_grows_only.gt.0)rr=max(rr,0.)
fire_rate_of_spread = rr
Expand All @@ -1409,7 +1414,7 @@ end function fire_rate_of_spread
subroutine fire_ros(ros_back,ros_wind,ros_slope, &
propx,propy,i,j,fp)
propx,propy,i,j,fp,ierrx,msg)
implicit none
Expand All @@ -1420,6 +1425,8 @@ subroutine fire_ros(ros_back,ros_wind,ros_slope, &
real, intent(in)::propx,propy
integer, intent(in)::i,j ! node mesh coordinates
type(fire_params),intent(in)::fp
integer, intent(out)::ierrx
character(len=*), intent(out)::msg
!*** local
real:: speed, tanphi ! windspeed and slope in the directino normal to the fireline
Expand Down Expand Up @@ -1451,7 +1458,7 @@ subroutine fire_ros(ros_back,ros_wind,ros_slope, &
endif
call fire_ros_cawfe(ros_back,ros_wind,ros_slope, &
speed,tanphi,cor_wind,cor_slope,i,j,fp)
speed,tanphi,cor_wind,cor_slope,i,j,fp,ierrx,msg)
end subroutine fire_ros
Expand All @@ -1460,7 +1467,7 @@ end subroutine fire_ros
!
subroutine fire_ros_cawfe(ros_back,ros_wind,ros_slope, &
speed,tanphi,cor_wind,cor_slope,i,j,fp)
speed,tanphi,cor_wind,cor_slope,i,j,fp,ierrx,msg)
implicit none
Expand Down Expand Up @@ -1492,15 +1499,18 @@ subroutine fire_ros_cawfe(ros_back,ros_wind,ros_slope, &
real, intent(in)::speed,tanphi,cor_wind,cor_slope
integer, intent(in)::i,j ! node mesh coordinates
type(fire_params),intent(in)::fp
integer, intent(out)::ierrx
character(len=*), intent(out)::msg
!*** local
real:: umid, phis, phiw, spdms, umidm, excess, tanphim,ros
real, parameter::ros_max=6.
character(len=128)msg
integer::k
!*** executable
ierrx = 0
if (.not. fp%ischap(i,j) > 0.) then ! if not chaparral, do not test for .eq. 0 for speed
if (ibeh .eq. 1) then ! use Rothermel formula
! ... if wind is 0 or into fireline, phiw = 0, &this reduces to backing ros.
Expand Down Expand Up @@ -1539,9 +1549,10 @@ subroutine fire_ros_cawfe(ros_back,ros_wind,ros_slope, &
ros=ros_back+ros_wind+ros_slope
if(ros > 1e-6 .and. fp%fmc_g(i,j) > fuelmce(k))then
!$OMP CRITICAL(SFIRE_PHYS_CRIT)
write(msg,'(a,2i6,3(a,e13.5))') 'WARNING: fire_ros_cawfe: at ',i,j,' rate of spread',ros,' moisture ',fp%fmc_g(i,j),'> extinction =',fuelmce(k)
write(msg,'(a,2i6,3(a,e13.5))') 'fire_ros_cawfe: at ',i,j,' rate of spread',ros,' moisture ',fp%fmc_g(i,j),'> extinction =',fuelmce(k)
!$OMP END CRITICAL(SFIRE_PHYS_CRIT)
call warning(msg)
! call warning(msg)
ierrx = 1
endif
!
else ! chaparral model from Clark et al 2004
Expand Down Expand Up @@ -1610,9 +1621,10 @@ subroutine fire_risk(fp, &
f_int,f_lineint,f_lineint2 ! fire intensities for danger rating
!*** local
integer:: i,j,k
integer:: i,j,k, ierrx
real:: cor_wind=1.,cor_slope=1.,dt_fake=1.
real:: ros_back,ros_wind,ros_slope,speed,tanphi,front_speed,ros_x,ros_y
character(len=128)::msg
!*** executable
Expand All @@ -1626,7 +1638,7 @@ subroutine fire_risk(fp, &
tanphi = sqrt(fp%dzdxf(i,j)*fp%dzdxf(i,j) + fp%dzdyf(i,j)*fp%dzdyf(i,j))+tiny(tanphi)
call fire_ros_cawfe(ros_back,ros_wind,ros_slope, &
speed,tanphi,cor_wind,cor_slope,i,j,fp)
speed,tanphi,cor_wind,cor_slope,i,j,fp, ierrx, msg)
ros_x = ros_wind * fp%vx(i,j)/speed + ros_slope * fp%dzdxf(i,j)/tanphi ! x direction component
ros_y = ros_wind * fp%vy(i,j)/speed + ros_slope * fp%dzdyf(i,j)/tanphi ! y direction component
Expand Down

0 comments on commit 05a8b8c

Please sign in to comment.