wrfv2_fire/var/da/da_ssmi/da_transform_xtotb_adj.inc

   1 subroutine da_transform_xtotb_adj (grid)
   2
   3    !----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type (domain), intent(inout) :: grid
  10
  11    integer :: i,j,k
  12    integer :: is, js, ie, je
  13
  14    real    :: dx, dy, dxm, dym, zhmkz
  15    real    :: dum1, dum2, zrhom, ADJ_zrhom
  16
  17    real    :: psfc,ta,gamma,sst,htpw,speed,alw,zcld,tpw
  18    real    :: ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst,ADJ_tpw
  19    real    :: ADJ_htpw,ADJ_speed,ADJ_alw,ADJ_zcld
  20
  21    if (trace_use) call da_trace_entry("da_transform_xtotb_adj")
  22
  23    psfc      = 0.0
  24    ta        = 0.0
  25    gamma     = 0.0
  26    sst       = 0.0
  27    htpw      = 0.0
  28    speed     = 0.0
  29    alw       = 0.0
  30    zcld      = 0.0
  31    tpw       = 0.0
  32    dx        = 0.0
  33    dy        = 0.0
  34    dxm       = 0.0
  35    dym       = 0.0
  36    zhmkz     = 0.0
  37    dum1      = 0.0
  38    dum2      = 0.0
  39    zrhom     = 0.0
  40    ADJ_zrhom = 0.0
  41
  42    is = its
  43    js = jts
  44
  45    ie = ite
  46    je = jte
  47
  48    if (test_transforms) then
  49       is = its-1
  50       js = jts-1
  51
  52       ie = ite+1
  53       je = jte+1
  54
  55       if (is < ids) is = ids
  56       if (js < jds) js = jds
  57
  58       if (ie > ide) ie = ide
  59       if (je > jde) je = jde
  60    end if
  61
  62    ! Mean fields
  63
  64    do j=js, je
  65       do i=is, ie
  66          psfc  = 0.01*grid%xb%psfc(i,j)
  67          ! sst   = grid%xb%tgrn(i,j)
  68          ta    = grid%xb%tgrn(i,j) + &
  69                  (grid%xb%t(i,j,kts)-grid%xb%tgrn(i,j))*log(2.0/0.0001)/ &
  70                  log((grid%xb%h(i,j,kts)- grid%xb%terr(i,j))/0.0001)
  71
  72          gamma = (ta-270.0)*0.023 + 5.03  ! effective lapse rate   (km) (4.0-6.5)
  73          zcld  = 1                      ! effective cloud height (km)
  74
  75          tpw   = grid%xb%tpw(i,j)*10.0
  76          ! speed = grid%xb%speed(i,j)
  77
  78          alw   = 0.0
  79
  80          zrhom = 0.0
  81          do k=kts,kte
  82             zrhom=zrhom+(grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k))*grid%xb%h(i,j,k)*grid%xb%q(i,j,k)* &
  83                grid%xb%rho(i,j,k)
  84          end do
  85
  86          ! call da_transform_xtozrhoq(grid%xb, i, j, zh, zf, zrhom)
  87
  88          htpw    = zrhom/tpw/1000.0
  89
  90          dum1=0.0
  91          dum2=0.0
  92
  93          ADJ_gamma    = 0.0
  94          ADJ_speed    = 0.0
  95          ADJ_psfc     = 0.0
  96          ADJ_zcld     = 0.0
  97          ADJ_htpw     = 0.0
  98          ADJ_sst      = 0.0
  99          ADJ_alw      = 0.0
 100          ADJ_tpw      = 0.0
 101          ADJ_ta       = 0.0
 102          ADJ_zrhom    = 0.0
 103
 104          call da_tb_adj(1,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw,      &
 105             htpw,grid%xb%speed(i,j),alw,zcld,               &
 106             ! grid%xb%tb19v(i,j),grid%xb%tb19h(i,j),               &
 107             ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst,         &
 108             ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw,        &
 109             ADJ_zcld,grid%xa%tb19v(i,j),grid%xa%tb19h(i,j)    )
 110
 111          call da_tb_adj(2,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw,      &
 112             htpw,grid%xb%speed(i,j),alw,zcld,               &
 113             ! grid%xb%tb22v(i,j),dum1,                        &
 114             ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst,         &
 115             ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw,        &
 116             ADJ_zcld,grid%xa%tb22v(i,j),dum2              )
 117
 118          call da_tb_adj(3,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw,      &
 119             htpw,grid%xb%speed(i,j),alw,zcld,               &
 120             ! grid%xb%tb37v(i,j),grid%xb%tb37h(i,j),               &
 121             ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst,         &
 122             ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw,        &
 123             ADJ_zcld,grid%xa%tb37v(i,j),grid%xa%tb37h(i,j)    )
 124
 125          call da_tb_adj(4,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw,      &
 126             htpw,grid%xb%speed(i,j),alw,zcld,               &
 127             ! grid%xb%tb85v(i,j),grid%xb%tb85h(i,j),               &
 128             ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst,         &
 129             ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw,        &
 130             ADJ_zcld,grid%xa%tb85v(i,j),grid%xa%tb85h(i,j)    )
 131
 132          ADJ_zrhom    = ADJ_htpw/tpw/1000.0
 133          ADJ_tpw      = ADJ_tpw - ADJ_htpw/tpw*htpw
 134
 135          do k = kts,kte
 136             grid%xa%rho(i,j,k) = (grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k))*grid%xb%h(i,j,k)* &
 137                grid%xb%q(i,j,k)*ADJ_zrhom + grid%xa%rho(i,j,k)
 138             grid%xa%q(i,j,k)   = (grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k))*grid%xb%h(i,j,k)* &
 139                ADJ_zrhom*grid%xb%rho(i,j,k) + grid%xa%q(i,j,k)
 140          end do
 141
 142          ! call da_transform_xtozrhoq_adj(grid%xb,grid%xa,i,j,zh,zf,ADJ_zrhom)
 143
 144          ADJ_alw = 0.0
 145
 146          grid%xa%speed(i,j)=grid%xa%speed(i,j) + ADJ_speed
 147
 148          grid%xa%tpw(i,j) = grid%xa%tpw(i,j) + ADJ_tpw*10.0
 149
 150          ADJ_zcld= 0
 151          ADJ_ta  = ADJ_ta + ADJ_gamma*0.023
 152
 153          grid%xa%t(i,j,kts) = grid%xa%t(i,j,kts) + ADJ_ta* &
 154                    log(2.0/0.0001)/log((grid%xb%h(i,j,kts)-grid%xb%terr(i,j))/0.0001)
 155          ADJ_sst = 0.0
 156
 157          grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + ADJ_psfc*0.01
 158       end do
 159    end do
 160
 161    if (trace_use) call da_trace_exit("da_transform_xtotb_adj")
 162
 163 end subroutine da_transform_xtotb_adj
 164
 165