Skip to content

Commit

Permalink
merging move of subroutine interpolate_z2fire from module_fr_fire_dri…
Browse files Browse the repository at this point in the history 
…ver.F to module_fr_fire_util.F

because it is used by the fuel moisture model in module_fr_fire_phys.F

merging subroutine print_3d_stats_by_slice into module_fr_fire_util.F
because it is used by the fuel moisture model in module_fr_fire_phys.F
  • Loading branch information
@janmandel
janmandel committed Jan 26, 2019
1 parent 2cf5c0a commit fbc0feb
Show file tree
Hide file tree
Showing 3 changed files with 107 additions and 87 deletions.
85 changes: 0 additions & 85 deletions phys/module_fr_fire_driver.F
View file
Expand Up @@ -1129,91 +1129,6 @@ end subroutine fire_ignition_convert
!*****************************
!

subroutine interpolate_z2fire(id, & ! for debug output, <= 0 no output
ids,ide, jds,jde, & ! atm grid dimensions
ims,ime, jms,jme, &
ips,ipe,jps,jpe, &
its,ite,jts,jte, &
ifds, ifde, jfds, jfde, & ! fire grid dimensions
ifms, ifme, jfms, jfme, &
ifts,ifte,jfts,jfte, &
ir,jr, & ! atm/fire grid ratio
zs, & ! atm grid arrays in
zsf,flag_z0) ! fire grid arrays out

implicit none
!*** purpose: interpolate height

!*** arguments
integer, intent(in)::id, &
ids,ide, jds,jde, & ! atm domain bounds
ims,ime,jms,jme, & ! atm memory bounds
ips,ipe,jps,jpe, &
its,ite,jts,jte, & ! atm tile bounds
ifds, ifde, jfds, jfde, & ! fire domain bounds
ifms, ifme, jfms, jfme, & ! fire memory bounds
ifts,ifte,jfts,jfte, & ! fire tile bounds
ir,jr ! atm/fire grid refinement ratio
real, intent(in), dimension(ims:ime, jms:jme):: zs ! terrain height at atm cell centers & ! terrain height
real,intent(out), dimension(ifms:ifme,jfms:jfme)::&
zsf ! terrain height fire grid nodes
integer,intent(in)::flag_z0


!*** local
real, dimension(its-2:ite+2,jts-2:jte+2):: za ! terrain height
integer:: i,j,jts1,jte1,its1,ite1,jfts1,jfte1,ifts1,ifte1,itso,jtso,iteo,jteo

! terrain height

jts1=max(jts-1,jds) ! lower loop limit by one less when at end of domain
its1=max(its-1,ids) ! ASSUMES THE HALO IS THERE if patch != domain
jte1=min(jte+1,jde)
ite1=min(ite+1,ide)
do j = jts1,jte1
do i = its1,ite1
! copy to local array
za(i,j)=zs(i,j)
enddo
enddo

call continue_at_boundary(1,1,0., & ! do x direction or y direction
its-2,ite+2,jts-2,jte+2, & ! memory dims
ids,ide,jds,jde, & ! domain dims - winds defined up to +1
ips,ipe,jps,jpe, & ! patch dims - winds defined up to +1
its1,ite1,jts1,jte1, & ! tile dims
itso,jtso,iteo,jteo, &
za) ! array

! interpolate to tile plus strip along domain boundary if at boundary
jfts1=snode(jfts,jfds,-1) ! lower loop limit by one less when at end of domain
ifts1=snode(ifts,ifds,-1)
jfte1=snode(jfte,jfde,+1)
ifte1=snode(ifte,ifde,+1)

call interpolate_2d( &
its-2,ite+2,jts-2,jte+2, & ! memory dims atm grid tile
its1-1,ite1+1,jts1-1,jte1+1, & ! where atm grid values set
ifms,ifme,jfms,jfme, & ! array dims fire grid
ifts1,ifte1,jfts1,jfte1, & ! dimensions fire grid tile
ir,jr, & ! refinement ratio
real(ids),real(jds),ifds+(ir-1)*0.5,jfds+(jr-1)*0.5, & ! line up by lower left corner of domain
za, & ! in atm grid
zsf) ! out fire grid

if (flag_z0 .eq. 1 ) then
do j=jfts1,jfte1
do i=ifts1,ifte1
zsf(i,j)=max(zsf(i,j),0.001)
enddo
enddo
endif

end subroutine interpolate_z2fire
!
!*****************************
!

subroutine interpolate_atm2fire(id, & ! for debug output, <= 0 no output
fire_wind_height, & ! interpolation height
ids,ide, kds,kde, jds,jde, & ! atm grid dimensions
Expand Down
4 changes: 2 additions & 2 deletions phys/module_fr_fire_phys.F
View file
Expand Up @@ -259,7 +259,7 @@ subroutine fuel_moisture( &
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
call interpolate_z2fire(id, & ! for debug output, <= 0 no output
ids,ide,jds,jde, & ! atm grid dimensions
its-1,ite+1,jts-1,jte+1, & ! memory dimensions
ips,ipe,jps,jpe, &
Expand All @@ -269,7 +269,7 @@ subroutine fuel_moisture( &
ifts,ifte, jfts,jfte, &
ir,jr, & ! atm/fire grid ratio
fmc_k, & ! atm grid arrays in
fmc_f) ! fire grid arrays out
fmc_f,0) ! fire grid arrays out

call print_2d_stats(ifts,ifte,jfts,jfte,ifts,ifte,jfts,jfte,fmc_f,'fuel_moisture: fmc_f')

Expand Down
105 changes: 105 additions & 0 deletions phys/module_fr_fire_util.F
View file
Expand Up @@ -54,9 +54,93 @@ module module_fr_fire_util

contains


subroutine interpolate_z2fire(id, & ! for debug output, <= 0 no output
ids,ide, jds,jde, & ! atm grid dimensions
ims,ime, jms,jme, &
ips,ipe,jps,jpe, &
its,ite,jts,jte, &
ifds, ifde, jfds, jfde, & ! fire grid dimensions
ifms, ifme, jfms, jfme, &
ifts,ifte,jfts,jfte, &
ir,jr, & ! atm/fire grid ratio
zs, & ! atm grid arrays in
zsf,flag_z0) ! fire grid arrays out

implicit none
!*** purpose: interpolate height

!*** arguments
integer, intent(in)::id, &
ids,ide, jds,jde, & ! atm domain bounds
ims,ime,jms,jme, & ! atm memory bounds
ips,ipe,jps,jpe, &
its,ite,jts,jte, & ! atm tile bounds
ifds, ifde, jfds, jfde, & ! fire domain bounds
ifms, ifme, jfms, jfme, & ! fire memory bounds
ifts,ifte,jfts,jfte, & ! fire tile bounds
ir,jr ! atm/fire grid refinement ratio
real, intent(in), dimension(ims:ime, jms:jme):: zs ! terrain height at atm cell centers & ! terrain height
real,intent(out), dimension(ifms:ifme,jfms:jfme)::&
zsf ! terrain height fire grid nodes
integer,intent(in)::flag_z0


!*** local
real, dimension(its-2:ite+2,jts-2:jte+2):: za ! terrain height
integer:: i,j,jts1,jte1,its1,ite1,jfts1,jfte1,ifts1,ifte1,itso,jtso,iteo,jteo

! terrain height

jts1=max(jts-1,jds) ! lower loop limit by one less when at end of domain
its1=max(its-1,ids) ! ASSUMES THE HALO IS THERE if patch != domain
jte1=min(jte+1,jde)
ite1=min(ite+1,ide)
do j = jts1,jte1
do i = its1,ite1
! copy to local array
za(i,j)=zs(i,j)
enddo
enddo

call continue_at_boundary(1,1,0., & ! do x direction or y direction
its-2,ite+2,jts-2,jte+2, & ! memory dims
ids,ide,jds,jde, & ! domain dims - winds defined up to +1
ips,ipe,jps,jpe, & ! patch dims - winds defined up to +1
its1,ite1,jts1,jte1, & ! tile dims
itso,jtso,iteo,jteo, &
za) ! array

! interpolate to tile plus strip along domain boundary if at boundary
jfts1=snode(jfts,jfds,-1) ! lower loop limit by one less when at end of domain
ifts1=snode(ifts,ifds,-1)
jfte1=snode(jfte,jfde,+1)
ifte1=snode(ifte,ifde,+1)

call interpolate_2d( &
its-2,ite+2,jts-2,jte+2, & ! memory dims atm grid tile
its1-1,ite1+1,jts1-1,jte1+1, & ! where atm grid values set
ifms,ifme,jfms,jfme, & ! array dims fire grid
ifts1,ifte1,jfts1,jfte1, & ! dimensions fire grid tile
ir,jr, & ! refinement ratio
real(ids),real(jds),ifds+(ir-1)*0.5,jfds+(jr-1)*0.5, & ! line up by lower left corner of domain
za, & ! in atm grid
zsf) ! out fire grid

if (flag_z0 .eq. 1 ) then
do j=jfts1,jfte1
do i=ifts1,ifte1
zsf(i,j)=max(zsf(i,j),0.001)
enddo
enddo
endif

end subroutine interpolate_z2fire

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

subroutine crash(s)
use module_wrf_error
implicit none
Expand Down Expand Up @@ -1000,6 +1084,27 @@ subroutine print_stat_line(name,ips,ipe,jps,jpe,min_a,max_a,avg_a)
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,k,k,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, &
a,name)
Expand Down

0 comments on commit fbc0feb

Please sign in to comment.