wrfv2_fire/phys/module_fire_driver.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 !
   3
   4 MODULE module_fire_driver
   5 CONTAINS
   6
   7 !------------------------------------------------------------------
   8
   9    SUBROUTINE fire_driver(ifire                                 &
  10             ,u,v,u_frame,v_frame,mu,rho                         & ! send
  11             ,itimestep,dt,dx,dy,z,z_at_w,dz8w,ht                &
  12             ,ids,  ide,  kds,  kde,  jds,  jde                  &
  13             ,ims,  ime,  kms,  kme,  jms,  jme                  &
  14             ,ifds, ifde, kfds, kfde, jfds, jfde                 &
  15             ,ifms, ifme, kfms, kfme, jfms, jfme                 &
  16             ,ifps, ifpe, kfps, kfpe, jfps, jfpe                 &
  17             ,kts,kte,num_tiles,i_start,i_end,j_start,j_end      &
  18             ,grid_id,cen_lat,cen_lon,lat_ll,lon_ll              &
  19             ,moad_cen_lat,moad_cen_lon                          &
  20             ,moad_lat_ll,moad_lon_ll,moad_dx,moad_dy            &
  21             ,moad_s_we,moad_e_we,moad_s_sn,moad_e_sn            &
  22             ,sr_x,sr_y                                          &
  23             ,fire_lat_init,fire_lon_init,fire_ign_time          &
  24             ,fire_shape,fire_crwn_hgt                           &
  25             ,fire_ext_grnd,fire_ext_crwn,fire_sprd_mdl          &
  26             ,fire_fuel_read,fire_fuel_cat                       &
  27             ,nfuel_cat_r,nfl,nfl_t,nfl_c,ncod,in1,in2,ixb,iyb     & ! send&recv
  28             ,icn,fg,fc,r_0,bbb,betafl,phiwc,area,area2          &
  29             ,zf,zsf,tign_g,tign_c,tign_crt,xfg,yfg,xcd          &
  30             ,ycd,xcn,ycn,sprdx,sprdy                            &
  31             ,rthfrten,rqvfrten                                  &
  32             ,grnhfx,grnqfx,canhfx,canqfx)                         ! recv
  33
  34 !------------------------------------------------------------------
  35
  36    USE module_state_description, ONLY :                         &
  37                    FIRE_CAWFE
  38
  39    USE module_model_constants
  40
  41 ! --- add new modules of schemes here
  42
  43    USE module_fr_cawfe
  44
  45    !  This driver calls subroutines for the fire parameterizations.
  46    !
  47    !  fire scheme:
  48    !      1. CAWFE scheme (Clark, Coen, Latham  2004)
  49    !
  50
  51 !------------------------------------------------------------------
  52    IMPLICIT NONE
  53 !======================================================================
  54 ! Grid structure in physics part of WRF
  55 !----------------------------------------------------------------------
  56 ! The horizontal velocities used in the physics are unstaggered
  57 ! relative to temperature/moisture variables. All predicted
  58 ! variables are carried at half levels except w, which is at full
  59 ! levels. Some arrays with names (*8w) are at w (full) levels.
  60 !
  61 !----------------------------------------------------------------------
  62 ! In WRF, kms (smallest number) is the bottom level and kme (largest
  63 ! number) is the top level.  In your scheme, if 1 is at the top level,
  64 ! then you have to reverse the order in the k direction.
  65 !
  66 !         kme      -   half level (no data at this level)
  67 !         kme    ----- full level
  68 !         kme-1    -   half level
  69 !         kme-1  ----- full level
  70 !         .
  71 !         .
  72 !         .
  73 !         kms+2    -   half level
  74 !         kms+2  ----- full level
  75 !         kms+1    -   half level
  76 !         kms+1  ----- full level
  77 !         kms      -   half level
  78 !         kms    ----- full level
  79 !
  80 !======================================================================
  81 ! Definitions
  82 !-----------
  83 !-- rthfrten      Theta tendency due to fire parameterization (K/s)
  84 !-- rqvfrten      Qv tendency due to fire parameterization (kg/kg/s)
  85 !-- itimestep     number of time steps
  86 !-- z             height above sea level (m)
  87 !-- dx            horizontal space interval (m)
  88 !-- dt            time step (second)
  89 !-- zs
  90 !-- ids           start index for i in domain
  91 !-- ide           end index for i in domain
  92 !-- jds           start index for j in domain
  93 !-- jde           end index for j in domain
  94 !-- kds           start index for k in domain
  95 !-- kde           end index for k in domain
  96 !-- ims           start index for i in memory
  97 !-- ime           end index for i in memory
  98 !-- jms           start index for j in memory
  99 !-- jme           end index for j in memory
 100 !-- kms           start index for k in memory
 101 !-- kme           end index for k in memory
 102 !-- jts           start index for j in tile
 103 !-- jte           end index for j in tile
 104 !-- kts           start index for k in tile
 105 !-- kte           end index for k in tile
 106 !
 107 !******************************************************************
 108 !------------------------------------------------------------------
 109 !
 110    INTEGER, INTENT(in) :: ifire
 111
 112    INTEGER, INTENT(in) :: ifds,ifde, jfds,jfde, kfds,kfde ! strt/end index domain
 113    INTEGER, INTENT(in) :: ifms,ifme, jfms,jfme, kfms,kfme ! strt/end index memory
 114    INTEGER, INTENT(in) :: ifps,ifpe, jfps,jfpe, kfps,kfpe ! strt/end index patch
 115
 116    INTEGER, INTENT(in) :: ids,ide, jds,jde, kds,kde  ! atmosphere domain dimensions
 117    INTEGER, INTENT(in) :: ims,ime, jms,jme, kms,kme  ! atmosphere memory dimensions
 118    INTEGER, INTENT(in) :: kts,kte, num_tiles         ! atmosphere tile dimensions
 119
 120    INTEGER, DIMENSION(num_tiles), INTENT(in) ::                   &
 121                                        i_start,i_end,j_start,j_end
 122
 123    INTEGER, INTENT(in) :: itimestep                  ! current time step (cumultiv)
 124    REAL,    INTENT(in) :: dt                         ! time step
 125    REAL,    INTENT(in) :: dx,dy                      ! dx,dy on innermost atm mesh
 126    INTEGER, INTENT(in) :: grid_id                    ! grid id of innermost atm mesh
 127    REAL, INTENT(in)    :: cen_lat,cen_lon            ! center lat,lon of " " "
 128    REAL, INTENT(in)    :: lat_ll,lon_ll              ! lat,lon of sw corner of " " "
 129    REAL, INTENT(in)    :: moad_cen_lat,moad_cen_lon  ! lat,lon of center of moad
 130    REAL, INTENT(in)    :: moad_lat_ll,moad_lon_ll    ! lat,lon of sw corner of moad
 131    REAL, INTENT(in)    :: moad_dx,moad_dy            ! dx,dy of moad
 132    INTEGER, INTENT(in) :: moad_s_we,moad_e_we        ! strt/stop grd pts in x moad
 133    INTEGER, INTENT(in) :: moad_s_sn,moad_e_sn        ! strt/stop grd pts in y moad
 134
 135    INTEGER, INTENT(in) :: sr_x,sr_y
 136    REAL, INTENT(in)    :: fire_lat_init,fire_lon_init
 137    REAL, INTENT(in)    :: fire_ign_time
 138    INTEGER, INTENT(in) :: fire_fuel_read
 139    INTEGER, INTENT(in) :: fire_shape
 140    REAL, INTENT(in)    :: fire_crwn_hgt
 141    REAL, INTENT(in)    :: fire_ext_crwn
 142    REAL, INTENT(in)    :: fire_ext_grnd
 143    INTEGER, INTENT(in) :: fire_sprd_mdl
 144    INTEGER, INTENT(in) :: fire_fuel_cat
 145    REAL, INTENT(in)    :: u_frame, v_frame
 146
 147    REAL, INTENT(in), DIMENSION( ims:ime, kms:kme, jms:jme ) :: u,v
 148    REAL, INTENT(in), DIMENSION( ims:ime, kms:kme, jms:jme ) :: z,z_at_w
 149    REAL, INTENT(in), DIMENSION( ims:ime, kms:kme, jms:jme ) :: rho
 150    REAL, INTENT(in), DIMENSION( ims:ime, kms:kme, jms:jme ) :: dz8w
 151    REAL, INTENT(in), DIMENSION( ims:ime, jms:jme ) :: ht
 152    REAL, INTENT(in), DIMENSION( ims:ime, jms:jme ) :: mu
 153
 154 ! ----- inout variables
 155
 156    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: nfuel_cat_r  ! jm because of WPS
 157    ! INTEGER, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: nfuel_cat_r
 158    INTEGER, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: nfl,nfl_t,nfl_c
 159    INTEGER, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: ncod
 160    INTEGER, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme,2 ) :: in1,in2
 161    INTEGER, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme,4 ) :: ixb,iyb,icn
 162
 163    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: fg,fc
 164    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: r_0,bbb,betafl,phiwc
 165    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: area,area2
 166    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: zf,zsf
 167    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme )   :: tign_g,tign_c,tign_crt
 168    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme,4 ) :: xfg,yfg
 169    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme,4 ) :: xcd,ycd
 170    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme,4 ) :: xcn,ycn
 171    REAL, INTENT(inout), DIMENSION( ifms:ifme,jfms:jfme,4 ) :: sprdx,sprdy
 172
 173    REAL, INTENT(inout), DIMENSION( ims:ime, kms:kme, jms:jme ) ::  &
 174                                                          rthfrten, &
 175                                                          rqvfrten
 176
 177    REAL, INTENT(inout), DIMENSION( ims:ime,jms:jme ) :: grnhfx,grnqfx
 178    REAL, INTENT(inout), DIMENSION( ims:ime,jms:jme ) :: canhfx,canqfx
 179
 180 ! ---- local variables
 181
 182    INTEGER :: i,j,k,nk,jj,ij,its,ite,jts,jte
 183
 184    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: v_tmp
 185    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: u_tmp
 186    CHARACTER(LEN=128) :: msg
 187
 188    INTEGER, DIMENSION( ifms:ifme,jfms:jfme )   :: nfuel_cat
 189
 190 !------------------------------------------------------------------
 191 !
 192     CALL wrf_debug(100,'entering fire_driver')
 193
 194 ! -- get u and v, zero tendencies
 195
 196    !$OMP PARALLEL DO   &
 197    !$OMP PRIVATE ( ij,i,j,k )
 198    DO ij = 1 , num_tiles
 199       DO j=j_start(ij),j_end(ij)
 200          DO k=kts,kte
 201             DO i=i_start(ij),i_end(ij)
 202                v_tmp(i,k,j) = v(i,k,j) + v_frame
 203                u_tmp(i,k,j) = u(i,k,j) + u_frame
 204             ENDDO
 205          ENDDO
 206          DO k=kts,min(kte+1,kde)
 207             DO i=i_start(ij),i_end(ij)
 208                rthfrten(i,k,j)=0.
 209                rqvfrten(i,k,j)=0.
 210             ENDDO
 211          ENDDO
 212       ENDDO
 213    ENDDO
 214    !$OMP END PARALLEL DO
 215 !
 216   !$OMP PARALLEL DO   &
 217   !$OMP PRIVATE ( ij, i,j,k, its, ite, jts, jte )
 218    DO ij = 1 , num_tiles
 219
 220       its = i_start(ij)   ! start atmospheric tile in i
 221       ite = i_end(ij)     ! end atmospheric tile in i
 222       jts = j_start(ij)   ! start atmospheric tile in j
 223       jte = j_end(ij)     ! end atmospheric tile in j
 224
 225       do j=jts,jte
 226          do i=its,ite
 227              nfuel_cat(i,j)=nfuel_cat_r(i,j)   ! nfuel_cat is real outside because of WPS
 228          enddo
 229       enddo
 230
 231       fire_select: SELECT CASE(ifire)
 232
 233       CASE (FIRE_CAWFE)
 234
 235         CALL wrf_debug(100,'entering CAWFE fire scheme')
 236
 237         CALL cawfe(                                             &
 238              ids,ide, kds,kde, jds,jde                          & ! send
 239             ,ims,ime, kms,kme, jms,jme                          &
 240             ,its,ite, kts,kte, jts,jte                          &
 241             ,ifds,ifde, kfds,kfde, jfds,jfde                    &
 242             ,ifms,ifme, kfms,kfme, jfms,jfme                    &
 243             ,itimestep,dt,dx,dy                                 &
 244             ,grid_id,cen_lat,cen_lon,lat_ll,lon_ll              &
 245             ,moad_cen_lat,moad_cen_lon                          &
 246             ,moad_lat_ll,moad_lon_ll,moad_dx,moad_dy            &
 247             ,moad_s_we,moad_e_we,moad_s_sn,moad_e_sn            &
 248             ,sr_x,sr_y                                          &
 249             ,fire_lat_init,fire_lon_init,fire_ign_time/60.      &
 250             ,fire_shape,fire_sprd_mdl,fire_crwn_hgt             &
 251             ,fire_ext_grnd,fire_ext_crwn                        &
 252             ,fire_fuel_read,fire_fuel_cat                       &
 253             ,z,z_at_w,dz8w,ht,u_tmp,v_tmp,mu,rho                &
 254             ,nfuel_cat,nfl,nfl_t,nfl_c,ncod,in1,in2,ixb,iyb     & ! send&recv
 255             ,icn,fg,fc,r_0,bbb,betafl,phiwc,area,area2          &
 256             ,zf,zsf,tign_g,tign_c,tign_crt,xfg,yfg,xcd          &
 257             ,ycd,xcn,ycn,sprdx,sprdy                            &
 258             ,rthfrten,rqvfrten                                  &
 259             ,grnhfx,grnqfx,canhfx,canqfx)                         ! recv
 260
 261         CALL wrf_debug(100,'exiting CAWFE fire scheme')
 262
 263      CASE DEFAULT
 264
 265        WRITE( msg , * ) 'This fire option does not exist: ifire = ', ifire
 266        CALL wrf_error_fatal ( msg )
 267
 268      END SELECT fire_select
 269
 270       do j=jts,jte
 271          do i=its,ite
 272              nfuel_cat_r(i,j)=nfuel_cat(i,j)   ! nfuel_cat is real outside because of WPS
 273          enddo
 274       enddo
 275
 276    ENDDO
 277    !$OMP END PARALLEL DO
 278
 279    END SUBROUTINE fire_driver
 280
 281 END MODULE module_fire_driver