wrfv2_fire/phys/module_fr_sfire_atm.F

   1 !WRF:MEDIATION_LAYER:FIRE_MODEL\r
   2 \r
   3 !*** Jan Mandel August 2007 - February 2008\r
   4 !*** email: jmandel@ucar.edu or Jan.Mandel@gmail.com or Jan.Mandel@cudenver.edu\r
   5 \r
   6 ! Routines dealing with the atmosphere\r
   7 \r
   8 module module_fr_sfire_atm\r
   9 \r
  10 use module_model_constants, only: cp,xlv\r
  11 use module_fr_sfire_util\r
  12 \r
  13 contains\r
  14 \r
  15 SUBROUTINE fire_tendency( &\r
  16     ids,ide, kds,kde, jds,jde,   & ! dimensions\r
  17     ims,ime, kms,kme, jms,jme,   &\r
  18     its,ite, kts,kte, jts,jte,   &\r
  19     grnhfx,grnqfx,canhfx,canqfx, & ! heat fluxes summed up to  atm grid \r
  20     alfg,alfc,z1can,             & ! coeffients, properties, geometry \r
  21     zs,z_at_w,dz8w,mu,rho,       &\r
  22     rthfrten,rqvfrten)             ! theta and Qv tendencies \r
  23 \r
  24 ! This routine is atmospheric physics \r
  25 ! it does NOT go into module_fr_sfire_phys because it is not fire physics\r
  26 \r
  27 ! taken from the code by Ned Patton, only order of arguments change to the convention here\r
  28 ! --- this routine takes fire generated heat and moisture fluxes and\r
  29 !     calculates their influence on the theta and water vapor \r
  30 ! --- note that these tendencies are valid at the Arakawa-A location\r
  31 \r
  32    IMPLICIT NONE\r
  33 \r
  34 ! --- incoming variables\r
  35 \r
  36    INTEGER , INTENT(in) :: ids,ide, kds,kde, jds,jde, &\r
  37                            ims,ime, kms,kme, jms,jme, &\r
  38                            its,ite, kts,kte, jts,jte\r
  39 \r
  40    REAL, INTENT(in), DIMENSION( ims:ime,jms:jme ) :: grnhfx,grnqfx  ! W/m^2\r
  41    REAL, INTENT(in), DIMENSION( ims:ime,jms:jme ) :: canhfx,canqfx  ! W/m^2\r
  42    REAL, INTENT(in), DIMENSION( ims:ime,jms:jme ) :: zs  ! topography (m abv sealvl)\r
  43    REAL, INTENT(in), DIMENSION( ims:ime,jms:jme ) :: mu  ! dry air mass (Pa)\r
  44 \r
  45    REAL, INTENT(in), DIMENSION( ims:ime,kms:kme,jms:jme ) :: z_at_w ! m abv sealvl\r
  46    REAL, INTENT(in), DIMENSION( ims:ime,kms:kme,jms:jme ) :: dz8w   ! dz across w-lvl\r
  47    REAL, INTENT(in), DIMENSION( ims:ime,kms:kme,jms:jme ) :: rho    ! density\r
  48 \r
  49    REAL, INTENT(in) :: alfg ! extinction depth ground fire heat (m)\r
  50    REAL, INTENT(in) :: alfc ! extinction depth crown  fire heat (m)\r
  51    REAL, INTENT(in) :: z1can    ! height of crown fire heat release (m)\r
  52 \r
  53 ! --- outgoing variables\r
  54 \r
  55    REAL, INTENT(out), DIMENSION( ims:ime,kms:kme,jms:jme ) ::   &\r
  56        rthfrten, & ! theta tendency from fire (in mass units)\r
  57        rqvfrten    ! Qv tendency from fire (in mass units)\r
  58 ! --- local variables\r
  59 \r
  60    INTEGER :: i,j,k\r
  61    INTEGER :: i_st,i_en, j_st,j_en, k_st,k_en\r
  62 \r
  63    REAL :: cp_i\r
  64    REAL :: rho_i\r
  65    REAL :: xlv_i\r
  66    REAL :: z_w\r
  67    REAL :: fact_g, fact_c\r
  68 \r
  69    REAL, DIMENSION( ims:ime,kms:kme,jms:jme ) :: hfx,qfx\r
  70    \r
  71 !!   character(len=128)::msg\r
  72 \r
  73 ! --- set some local constants\r
  74    \r
  75 \r
  76    cp_i = 1./cp     ! inverse of specific heat\r
  77    xlv_i = 1./xlv   ! inverse of latent heat\r
  78 \r
  79 !!write(msg,'(8e11.3)')cp,cp_i,xlv,xlv_i,alfg,alfc,z1can\r
  80 !!call message(msg)\r
  81 \r
  82    call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme,grnhfx,'fire_tendency:grnhfx')\r
  83    call print_2d_stats(its,ite,jts,jte,ims,ime,jms,jme,grnqfx,'fire_tendency:grnqfx')\r
  84 \r
  85 ! --- set loop indicies : note that \r
  86 \r
  87    i_st = MAX(its,ids+1)\r
  88    i_en = MIN(ite,ide-1)\r
  89    k_st = kts\r
  90    k_en = MIN(kte,kde-1)\r
  91    j_st = MAX(jts,jds+1)\r
  92    j_en = MIN(jte,jde-1)\r
  93 \r
  94 ! --- distribute fluxes\r
  95 \r
  96    DO j = j_st,j_en\r
  97       DO k = k_st,k_en\r
  98          DO i = i_st,i_en\r
  99 \r
 100             ! --- set z (in meters above ground)\r
 101 \r
 102             z_w = z_at_w(i,k,j) - zs(i,j) ! should be zero when k=k_st\r
 103 \r
 104             ! --- heat flux\r
 105 \r
 106             fact_g = cp_i * EXP( - alfg * z_w )\r
 107             IF ( z_w < z1can ) THEN\r
 108                fact_c = cp_i\r
 109             ELSE\r
 110                fact_c = cp_i * EXP( - alfc * (z_w - z1can) )\r
 111             END IF\r
 112             hfx(i,k,j) = fact_g * grnhfx(i,j) + fact_c * canhfx(i,j) \r
 113 \r
 114 !!            write(msg,2)i,k,j,z_w,grnhfx(i,j),hfx(i,k,j)\r
 115 !!2           format('hfx:',3i4,6e11.3)\r
 116 !!            call message(msg)\r
 117 \r
 118             ! --- vapor flux\r
 119 \r
 120             fact_g = xlv_i * EXP( - alfg * z_w )\r
 121             IF (z_w < z1can) THEN\r
 122                fact_c = xlv_i\r
 123             ELSE\r
 124                fact_c = xlv_i * EXP( - alfc * (z_w - z1can) )\r
 125             END IF\r
 126             qfx(i,k,j) = fact_g * grnqfx(i,j) + fact_c * canqfx(i,j) \r
 127             \r
 128 !!            if(hfx(i,k,j).ne.0. .or. qfx(i,k,j) .ne. 0.)then\r
 129 !!                write(msg,1)i,k,j,hfx(i,k,j),qfx(i,k,j)\r
 130 !!1               format('tend:',3i6,2e11.3)\r
 131 !!                call message(msg)\r
 132 !            endif\r
 133 \r
 134          END DO\r
 135       END DO\r
 136    END DO\r
 137 \r
 138 ! --- add flux divergence to tendencies\r
 139 !\r
 140 !   multiply by dry air mass (mu) to eliminate the need to \r
 141 !   call sr. calculate_phy_tend (in dyn_em/module_em.F)\r
 142 \r
 143    DO j = j_st,j_en\r
 144       DO k = k_st,k_en-1\r
 145          DO i = i_st,i_en\r
 146 \r
 147             rho_i = 1./rho(i,k,j)\r
 148 \r
 149             rthfrten(i,k,j) = - mu(i,j) * rho_i * (hfx(i,k+1,j)-hfx(i,k,j)) / dz8w(i,k,j)\r
 150             rqvfrten(i,k,j) = - mu(i,j) * rho_i * (qfx(i,k+1,j)-qfx(i,k,j)) / dz8w(i,k,j)\r
 151 \r
 152          END DO\r
 153       END DO\r
 154    END DO\r
 155 \r
 156    call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,rthfrten,'fire_tendency:rthfrten')\r
 157    call print_3d_stats(its,ite,kts,kte,jts,jte,ims,ime,kms,kme,jms,jme,rqvfrten,'fire_tendency:rqvfrten')\r
 158 \r
 159    RETURN\r
 160 \r
 161 END SUBROUTINE fire_tendency\r
 162 \r
 163 end module module_fr_sfire_atm\r