phys/module_fr_sfire_driver_wrf.F

   1 ! WRF:MEDIATION_LAYER:FIRE_MODEL
   2
   3 ! This is WRF interface driver for SFIRE, the fire module in WRF-Fire.
   4 ! Please see module_fr_sfire_driver.F for acknowledgements.
   5
   6
   7 #define DEBUG_OUT
   8
   9 module module_fr_sfire_driver_wrf
  10 ! wrf-specific driver
  11
  12 use module_fr_sfire_driver
  13 use module_fr_sfire_atm
  14 USE module_utility, only: WRFU_TimeInterval,WRFU_TimeIntervalGet, WRFU_SUCCESS
  15 implicit none
  16
  17 contains
  18
  19 subroutine sfire_driver_em_init (grid , config_flags               &
  20             ,ids,ide, kds,kde, jds,jde                              &
  21             ,ims,ime, kms,kme, jms,jme                              &
  22             ,ips,ipe, kps,kpe, jps,jpe)
  23
  24     ! stub to call sfire_driver_em with irun=0 and omit last 3 args
  25
  26     USE module_domain , only: domain , get_ijk_from_subgrid , &
  27                               domain_get_time_since_sim_start , &
  28                               domain_get_time_step
  29     USE module_configure , only : grid_config_rec_type
  30     implicit none
  31
  32     TYPE(domain) , TARGET          :: grid   ! data
  33     TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
  34     integer, intent(in):: &
  35              ids,ide, kds,kde, jds,jde                              &
  36             ,ims,ime, kms,kme, jms,jme                              &
  37             ,ips,ipe, kps,kpe, jps,jpe
  38
  39 #include "commit_decl"
  40
  41     ! local
  42     integer :: &  ! fire mesh sizes
  43              ifds,ifde, kfds,kfde, jfds,jfde,                              &
  44              ifms,ifme, kfms,kfme, jfms,jfme,                              &
  45              ifps,ifpe, kfps,kfpe, jfps,jfpe
  46     real::time_step_start, dt ! dummies, avoid uninitialized
  47     ! dummies
  48
  49     call message('sfire_driver_em_init: SFIRE initialization start')
  50     ! call message(commit_version,level=0)
  51
  52     ! get fire mesh dimensions
  53     CALL get_ijk_from_subgrid (  grid ,                   &
  54                             ifds,ifde, jfds,jfde,kfds,kfde,                        &
  55                             ifms,ifme, jfms,jfme,kfms,kfme,                        &
  56                             ifps,ifpe, jfps,jfpe,kfps,kfpe)
  57
  58     ! times in seconds
  59     time_step_start=TimeInterval2Sec(domain_get_time_since_sim_start(grid))
  60     dt=TimeInterval2Sec(domain_get_time_step(grid))
  61
  62     call sfire_driver_em ( grid , config_flags               &
  63             ,time_step_start,dt                                 &
  64             ,ifun_beg,ifun_step-1,0                        & ! ifun start, end, test steps
  65             ,ids,ide, kds,kde, jds,jde                              &
  66             ,ims,ime, kms,kme, jms,jme                              &
  67             ,ips,ipe, kps,kpe, jps,jpe                              &
  68             ,ifds,ifde, jfds,jfde                                   &
  69             ,ifms,ifme, jfms,jfme                                   &
  70             ,ifps,ifpe, jfps,jfpe                                   &
  71             )
  72
  73     call message('sfire_driver_em_init: SFIRE initialization complete')
  74
  75 end subroutine sfire_driver_em_init
  76
  77 !
  78 !***
  79 !
  80
  81 subroutine sfire_driver_em_step (grid , config_flags               &
  82             ,ids,ide, kds,kde, jds,jde                              &
  83             ,ims,ime, kms,kme, jms,jme                              &
  84             ,ips,ipe, kps,kpe, jps,jpe                              &
  85             ,rho,z_at_w,dz8w )
  86
  87     ! stub to call sfire_driver_em
  88
  89     USE module_domain, only: domain , get_ijk_from_subgrid , &
  90                               domain_get_time_since_sim_start , &
  91                               domain_get_time_step
  92     USE module_configure , only : grid_config_rec_type
  93     USE module_fr_sfire_util, only : fire_test_steps
  94     USE module_state_description, only: num_tracer
  95 #ifdef WRF_CHEM
  96     USE module_state_description, only: num_chem
  97 #endif
  98     implicit none
  99
 100     TYPE(domain) , TARGET          :: grid   ! data
 101     TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
 102     integer, intent(in):: &
 103              ids,ide, kds,kde, jds,jde                              &
 104             ,ims,ime, kms,kme, jms,jme                              &
 105             ,ips,ipe, kps,kpe, jps,jpe
 106     real,dimension(ims:ime, kms:kme, jms:jme),intent(in)::rho,z_at_w,dz8w
 107
 108
 109     ! local
 110     integer :: &  ! fire mesh sizes
 111              ifds,ifde, kfds,kfde, jfds,jfde,                              &
 112              ifms,ifme, kfms,kfme, jfms,jfme,                              &
 113              ifps,ifpe, kfps,kfpe, jfps,jfpe
 114     integer :: its,ite,jts,jte,kts,kte            ! atm tile
 115     integer:: ij, ipe1,jpe1,kpe1
 116     real::time_step_start,dt
 117
 118     integer::fire_time_step_ratio,itime_step,i,j
 119     real,dimension( ips:ipe , jps:jpe ) :: grnhfx_save, grnqfx_save,    &
 120                                            canhfx_save, canqfx_save
 121     character(len=128)::msg
 122
 123     ! executable
 124
 125     call message('sfire_driver_em_step: SFIRE step start')
 126
 127     ! times in seconds
 128
 129     ! get fire time step refinement from namelist
 130     fire_time_step_ratio=config_flags%fire_time_step_ratio
 131
 132     if(fire_time_step_ratio.lt.1)then
 133         call crash('fire_time_step_ratio must be >= 1')
 134     endif
 135
 136     time_step_start=TimeInterval2Sec(domain_get_time_since_sim_start(grid))
 137     dt=TimeInterval2Sec(domain_get_time_step(grid))/fire_time_step_ratio
 138
 139
 140     ! get fire mesh dimensions
 141     CALL get_ijk_from_subgrid (  grid ,                   &
 142                             ifds,ifde, jfds,jfde,kfds,kfde,                        &
 143                             ifms,ifme, jfms,jfme,kfms,kfme,                        &
 144                             ifps,ifpe, jfps,jfpe,kfps,kfpe)
 145
 146     ! save fluxes for tendency
 147     grnhfx_save(:,:)=0.
 148     grnqfx_save(:,:)=0.
 149     canhfx_save(:,:)=0.
 150     canqfx_save(:,:)=0.
 151
 152     ! ignore last row in domain, not set properly
 153     ! done below when setting ite,jte
 154     ipe1 = min(ipe,ide-1)
 155     jpe1 = min(jpe,jde-1)
 156     kpe1=kpe-1
 157
 158     ! fire time step loop
 159     do itime_step = 1,fire_time_step_ratio
 160
 161     call sfire_driver_em ( grid , config_flags               &
 162             ,time_step_start,dt                                 &
 163             ,ifun_step,ifun_end,fire_test_steps                     &
 164             ,ids,ide, kds,kde, jds,jde                              &
 165             ,ims,ime, kms,kme, jms,jme                              &
 166             ,ips,ipe, kps,kpe, jps,jpe                              &
 167             ,ifds,ifde, jfds,jfde                                   &
 168             ,ifms,ifme, jfms,jfme                                   &
 169             ,ifps,ifpe, jfps,jfpe                                   &
 170             ,rho,z_at_w,dz8w                                        &
 171             )
 172
 173         ! accumulate fluxes for atmospheric tendency
 174         do j=jps,jpe1
 175             do i=ips,ipe1
 176                 grnhfx_save(i,j)=grnhfx_save(i,j) + grid%grnhfx(i,j)
 177                 grnqfx_save(i,j)=grnqfx_save(i,j) + grid%grnqfx(i,j)
 178                 canhfx_save(i,j)=canhfx_save(i,j) + grid%canhfx(i,j)
 179                 canqfx_save(i,j)=canqfx_save(i,j) + grid%canqfx(i,j)
 180             enddo
 181         enddo
 182
 183         time_step_start=time_step_start+dt
 184     enddo
 185
 186         ! copy fluxes back to grid structure
 187         do j=jps,jpe1
 188             do i=ips,ipe1
 189                 grid%grnhfx(i,j)=grnhfx_save(i,j)/fire_time_step_ratio
 190                 grid%grnqfx(i,j)=grnqfx_save(i,j)/fire_time_step_ratio
 191                 grid%canhfx(i,j)=canhfx_save(i,j)/fire_time_step_ratio
 192                 grid%canqfx(i,j)=canqfx_save(i,j)/fire_time_step_ratio
 193             enddo
 194         enddo
 195
 196
 197    call print_chsum(0,ims,ime,kms,kme,jms,jme,ids,ide,kds,kde,jds,jde,ips,ipe1,kps,kpe1,jps,jpe1,0,0,0,z_at_w,'z_at_w')
 198    call print_chsum(0,ims,ime,kms,kme,jms,jme,ids,ide,kds,kde,jds,jde,ips,ipe1,kps,kpe1,jps,jpe1,0,0,0,dz8w,'dz8w')
 199    call print_chsum(0,ims,ime,kms,kme,jms,jme,ids,ide,kds,kde,jds,jde,ips,ipe1,kps,kpe1,jps,jpe1,0,0,0,rho,'rho')
 200    call print_chsum(0,ims,ime,1,1,jms,jme,ids,ide,1,1,jds,jde,ips,ipe1,1,1,jps,jpe1,0,0,0,grid%mut,'mu')
 201    call print_3d_stats(ips,ipe1,kps,kpe1,jps,jpe1,ims,ime,kms,kme,jms,jme,rho,'rho')
 202    call print_3d_stats(ips,ipe1,kps,kpe1,jps,jpe1,ims,ime,kms,kme,jms,jme,z_at_w,'z_at_w')
 203    call print_3d_stats(ips,ipe1,kps,kpe1,jps,jpe1,ims,ime,kms,kme,jms,jme,dz8w,'dz8w')
 204
 205     ! --- add heat and moisture fluxes to tendency variables by postulated decay
 206     do ij=1,grid%num_tiles
 207        ! SFIRE works on domain by 1 smaller, in last row&col winds are not set properly
 208        its = grid%i_start(ij)             ! start atmospheric tile in i
 209        ite = min(grid%i_end(ij),ide-1)    ! end atmospheric tile in i
 210        jts = grid%j_start(ij)             ! start atmospheric tile in j
 211        jte = min(grid%j_end(ij),jde-1)    ! end atmospheric tile in j
 212        kts=kds
 213        kte=kde
 214
 215        call fire_tendency(                 &
 216             ids,ide-1, kds,kde, jds,jde-1, & ! domain dimensions
 217             ims,ime, kms,kme, jms,jme,      &
 218             its,ite, kts,kte, jts,jte,      & !
 219             grid%grnhfx,grid%grnqfx,grid%canhfx,grid%canqfx,        & ! fluxes on atm grid
 220             config_flags%fire_ext_grnd,config_flags%fire_ext_crwn,config_flags%fire_crwn_hgt,                &
 221             grid%ht,z_at_w,dz8w,grid%mut,rho,          &
 222             grid%rthfrten,grid%rqvfrten)                ! out
 223
 224      enddo
 225
 226 #ifdef WRF_CHEM
 227
 228      write(msg,991)lbound(grid%chem,4),ubound(grid%chem,4)
 229 991  format('chem array dimensions ',i3,':',i3)
 230      call message(msg)
 231      write(msg,992)num_chem, config_flags%chem_opt
 232 992  format('number of chem species:',i4,' chem_opt=',i3)
 233      call message(msg)
 234
 235 #endif
 236
 237      write(msg,993)lbound(grid%tracer,4),ubound(grid%tracer,4)
 238 993  format('tracer array dimensions ',i3,':',i3)
 239      call message(msg)
 240      write(msg,994)num_tracer,config_flags%tracer_opt
 241 994  format('number of tracers:',i3,' tracer_opt=',i3)
 242      call message(msg)
 243
 244        ! debug print to compare
 245
 246        call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,grid%rthfrten,'fire_driver_phys:rthfrten')
 247        call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,grid%rqvfrten,'fire_driver_phys:rqvfrten')
 248
 249     call message('sfire_driver_em_step: SFIRE step complete')
 250
 251 end subroutine sfire_driver_em_step
 252
 253 double precision function TimeInterval2Sec(time)
 254 ! convert ESMF_Timeinterval type to seconds
 255 ! has double precision type just in case it is needed in future
 256 ! will silently convert to single precition on use.
 257     TYPE(WRFU_TimeInterval), intent(in) :: time
 258 ! local
 259     integer::rc,S,Sn,Sd
 260 ! executable
 261     call WRFU_TimeIntervalGet(time,S=S,Sd=Sd,Sn=Sn,rc=rc)
 262     if(rc.ne.WRFU_SUCCESS)call crash('TimeInterval2Sec: WRFU_TimeIntervalGet failed')
 263     ! print *,'WRFU_TimeIntervalGet returned S=',S,'Sn=',Sn,'Sd=',Sd
 264     if(Sd.ne.0)then
 265          TimeInterval2Sec=dble(S)+dble(Sn)/dble(Sd)
 266     else
 267          TimeInterval2Sec=dble(S)
 268     endif
 269 end function TimeInterval2Sec
 270
 271 end module module_fr_sfire_driver_wrf
 272