wrfv2_fire/var/da/da_setup_structures/da_setup_firstguess_wrf.inc

   1 subroutine da_setup_firstguess_wrf(xbx, grid, config_flags)
   2
   3    !---------------------------------------------------------------------------
   4    ! Purpose: Define/allocate components of WRF model state.
   5    !---------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type (xbx_type), intent(out)         :: xbx    ! Header & non-gridded vars.
  10
  11    type (domain), intent(inout)         :: grid
  12    type(grid_config_rec_type), intent(in) :: config_flags
  13
  14    integer           :: map_util_project
  15    real              :: x, y, lat_cen, lon_cen
  16
  17    real              :: buf(2)
  18
  19    character(len=24) :: xb_date, an_date
  20    integer           :: len, seconds, i_grid,  j_grid, m_expand
  21
  22
  23    if (trace_use) call da_trace_entry("da_setup_firstguess_wrf")
  24
  25    !-----------------------------------------------------------------------
  26    ! [0.0] check the xb_date for 3DVAR
  27    !-----------------------------------------------------------------------
  28
  29    if ( num_fgat_time == 1 ) then
  30       write(unit=xb_date,fmt='(i4.4,2("-",i2.2),"_",i2.2,2(":",i2.2),".0000")')  &
  31            grid%start_year, grid%start_month, grid%start_day, &
  32            grid%start_hour, grid%start_minute,grid%start_second
  33
  34       len = len_trim(ANALYSIS_DATE)
  35
  36       write(unit=an_date(1:len), fmt='(a)') trim(ANALYSIS_DATE)
  37
  38       seconds = int(da_diff_seconds(an_date, xb_date))
  39
  40       if (seconds > ANALYSIS_ACCU) then
  41          write(unit=message(1),fmt='(A,A,A,A)') &
  42             "xb_date=",xb_date," an_date=", an_date
  43          write(unit=message(2),fmt='(A,I6,A,I6)') &
  44             "diff=",seconds,"   ANALYSIS_ACCU=",ANALYSIS_ACCU
  45          message(3)="=======> Wrong xb time found???"
  46          call da_warning(__FILE__,__LINE__,message(1:3))
  47       end if
  48    end if
  49
  50    !------------------------------------------------------------------------
  51    ! [1.0] Read original WRF format first guess:
  52    !------------------------------------------------------------------------
  53
  54    !------------------------------------------------------------------------
  55    ! [2.0] Copy header info:
  56    !------------------------------------------------------------------------
  57
  58    if ((grid%xp%its == grid%xp%ids) .and. (grid%xp%jts == grid%xp%jds)) then
  59       buf(1) = grid%xlat(grid%xp%its, grid%xp%jts)
  60       buf(2) = grid%xlong(grid%xp%its, grid%xp%jts)
  61    end if
  62
  63    call wrf_dm_bcast_real(buf, 2)
  64    start_lat=buf(1)
  65    start_lon=buf(2)
  66
  67    !------------------------------------------------------------------------
  68    ! Setup map utility
  69    !------------------------------------------------------------------------
  70
  71    call nl_get_map_proj     (grid%id , grid%map_proj)
  72    call nl_get_truelat1     (grid%id , grid%truelat1)
  73    call nl_get_truelat2     (grid%id , grid%truelat2)
  74    call nl_get_dx           (grid%id , grid%dx)
  75    call nl_get_cen_lat      (grid%id , grid%cen_lat)
  76    call nl_get_cen_lon      (grid%id , grid%cen_lon)
  77    call nl_get_moad_cen_lat (grid%id , grid%moad_cen_lat)
  78    call nl_get_stand_lon    (grid%id , grid%stand_lon)
  79
  80    phic = grid%moad_cen_lat
  81    xlonc = grid%stand_lon
  82
  83    truelat1_3dv = grid%truelat1
  84    truelat2_3dv = grid%truelat2
  85    pole = 90.0
  86    dsm = 0.001 * grid%dx
  87
  88    map_util_project = grid%map_proj
  89
  90    if (print_detail_map) then
  91       write(unit=stdout, fmt='(a, i6)') &
  92            'map_proj =', grid%map_proj
  93
  94       write(unit=stdout, fmt='(a, e16.6)') &
  95            'cen_lat  =', grid%cen_lat,  &
  96            'cen_lon  =', grid%cen_lon,  &
  97            'truelat1 =', grid%truelat1, &
  98            'truelat2 =', grid%truelat2, &
  99            'start_lat =', start_lat, &
 100            'start_lon =', start_lon, &
 101            'dsm      =', dsm
 102    end if
 103
 104    ! Set map projection in WRFSI world.
 105    map_util_project = PROJ_LC
 106
 107    if (grid%map_proj == 0 .or. grid%map_proj == 6 ) then
 108       map_util_project = PROJ_LATLON
 109    else if (grid%map_proj == 1) then
 110       map_util_project = PROJ_LC
 111    else if (grid%map_proj == 2) then
 112       map_util_project = PROJ_PS
 113    else if (grid%map_proj == 3) then
 114       map_util_project = PROJ_MERC
 115    end if
 116
 117    call da_map_set(map_util_project,grid%cen_lat,grid%cen_lon,   &
 118                 real(grid%xp%ide-grid%xp%ids+2)/2.0, real(grid%xp%jde-grid%xp%jds+2)/2.0, &
 119                 grid%dx,grid%stand_lon,grid%truelat1,grid%truelat2,grid%truelat1,grid%stand_lon,map_info)
 120
 121    ! Need to set map projection in WRF world.
 122    map_projection = grid%map_proj
 123
 124    cone_factor = map_info%cone
 125
 126    if (.not. global .and. print_detail_map) then
 127
 128       !----------------------------------------------------------------------
 129       ! Check the ll_to_ij:
 130       !----------------------------------------------------------------------
 131
 132       message(1)="Check the map_set correctness::::::::::::::::::::::::"
 133
 134       ! Domain center:
 135       call  da_llxy_wrf(map_info, grid%cen_lat, grid%cen_lon, start_x, start_y)
 136       write(unit=message(2),fmt='("Center: latc,lonc,x,y, Xc, Yc:",6f10.3)') &
 137                   grid%cen_lat, grid%cen_lon, start_x, start_y, &
 138                   real(grid%xp%ide-grid%xp%ids+2)/2.0, real(grid%xp%jde-grid%xp%jds+2)/2.0
 139
 140       start_x = real(grid%xp%ide-grid%xp%ids+2)/2.0
 141       start_y = real(grid%xp%jde-grid%xp%jds+2)/2.0
 142       lat_cen = -999.9
 143       lon_cen = -999.9
 144       call  da_xyll(map_info, start_x, start_y, lat_cen, lon_cen)
 145       write(unit=message(3), &
 146          fmt='("Center: X, Y, latc, lonc, phic, xlonc:",6f10.3)') &
 147          start_x, start_y, lat_cen, lon_cen,   &
 148          grid%cen_lat, grid%cen_lon
 149       call da_message(message(1:3))
 150    end if
 151
 152    ! Setup the domain definition for use of the GRAPH:
 153
 154    coarse_ds = 0.001 * grid%dx
 155    coarse_ix = grid%e_we - grid%s_we + 1
 156    coarse_jy = grid%e_sn - grid%s_sn + 1
 157    start_x = 1.0
 158    start_y = 1.0
 159
 160    if( fg_format==fg_format_kma_global) then
 161    delt_lat = 180.0/real(grid%e_sn - grid%s_sn - 1)
 162    delt_lon = 360.0/real(grid%e_we - grid%s_we)
 163    else if( fg_format==fg_format_wrf_arw_global) then
 164    delt_lat = 180.0/real(grid%e_sn - grid%s_sn)
 165    delt_lon = 360.0/real(grid%e_we - grid%s_we)
 166    else
 167    call da_set_map_para ! set up the map background parameters
 168    end if
 169
 170    !--------------------------------------------------------------------------
 171    ! [3.0] Interpolate WRF C-grid winds to p points of WRFVAR grid (interpolate
 172    ! u to west, v to south?
 173    !---------------------------------------------------------------------------
 174
 175    grid%xb % mix = grid%xp%ide - grid%xp%ids + 1
 176    grid%xb % mjy = grid%xp%jde - grid% xp%jds + 1
 177    grid%xb % mkz = grid%xp%kde - grid%xp%kds + 1
 178
 179    grid%xb % ds  = 0.001 * grid%dx
 180
 181    mix = grid%xb % mix
 182    mjy = grid%xb % mjy
 183    mkz = grid%xb % mkz
 184
 185    call da_transfer_wrftoxb(xbx, grid, config_flags)
 186
 187    if (trace_use) call da_trace_exit("da_setup_firstguess_wrf")
 188
 189 end subroutine da_setup_firstguess_wrf
 190
 191