var/da/da_setup_structures/da_setup_firstguess_wrf_nmm_regional.inc

   1 subroutine da_setup_firstguess_wrf_nmm_regional(xbx, grid)
   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
  13    integer           :: map_util_project
  14    real              :: x, y, xxc, yyc, lat_cen, lon_cen
  15
  16    real              :: buf(2)
  17
  18    character(len=24) :: xb_date, an_date
  19    integer           :: len, seconds, i_grid,  j_grid, m_expand
  20    real              :: latinc, loninc
  21
  22    if (trace_use) call da_trace_entry("da_setup_firstguess_wrf_nmm_regional")
  23
  24    !-----------------------------------------------------------------------
  25    ! [0.0] check the xb_date for 3DVAR
  26    !-----------------------------------------------------------------------
  27
  28    write(unit=xb_date,fmt='(i4.4,2("-",i2.2),"_",i2.2,2(":",i2.2),".0000")')  &
  29         grid%start_year, grid%start_month, grid%start_day, &
  30         grid%start_hour, grid%start_minute,grid%start_second
  31
  32    len = len_trim(ANALYSIS_DATE)
  33
  34    write(unit=an_date(1:len), fmt='(a)') trim(ANALYSIS_DATE)
  35
  36    seconds = int(da_diff_seconds(an_date, xb_date))
  37
  38    if (seconds > ANALYSIS_ACCU) then
  39       write(unit=message(1),fmt='(A,A,A,A)') &
  40          "xb_date=",xb_date," an_date=", an_date
  41       write(unit=message(2),fmt='(A,I6,A,I6)') &
  42          "diff=",seconds,"   ANALYSIS_ACCU=",ANALYSIS_ACCU
  43       message(3)="=======> Wrong xb time found???"
  44       call da_warning(__FILE__,__LINE__,message(1:3))
  45    end if
  46
  47    !------------------------------------------------------------------------
  48    ! [1.0] Read original WRF format first guess:
  49    !------------------------------------------------------------------------
  50
  51    !------------------------------------------------------------------------
  52    ! [2.0] Copy header info:
  53    !------------------------------------------------------------------------
  54
  55    if ((grid%xp%its == grid%xp%ids) .and. (grid%xp%jts == grid%xp%jds)) then
  56       buf(1) = grid%xlat(grid%xp%its, grid%xp%jts)
  57       buf(2) = grid%xlong(grid%xp%its, grid%xp%jts)
  58    end if
  59
  60    call wrf_dm_bcast_real(buf, 2)
  61    start_lat=buf(1)
  62    start_lon=buf(2)
  63
  64    !------------------------------------------------------------------------
  65    ! Setup map utility
  66    !------------------------------------------------------------------------
  67
  68    call nl_get_map_proj     (grid%id , grid%map_proj)
  69    call nl_get_truelat1     (grid%id , grid%truelat1)
  70    call nl_get_truelat2     (grid%id , grid%truelat2)
  71    call nl_get_dx           (grid%id , grid%dx)
  72    call nl_get_cen_lat      (grid%id , grid%cen_lat)
  73    call nl_get_cen_lon      (grid%id , grid%cen_lon)
  74    call nl_get_moad_cen_lat (grid%id , grid%moad_cen_lat)
  75    call nl_get_stand_lon    (grid%id , grid%stand_lon)
  76
  77    phic   = grid%moad_cen_lat
  78    xlonc  = grid%cen_lon
  79    loninc = grid%cf1
  80    latinc = grid%cf2
  81
  82    truelat1_3dv = grid%truelat1
  83    truelat2_3dv = grid%truelat2
  84    pole = 90.0
  85    dsm = 0.001 * grid%dx
  86
  87    map_util_project = grid%map_proj
  88    ! Set map projection in WRFSI world.
  89
  90    if (grid%map_proj == 0 .or. grid%map_proj == 6) then
  91       map_util_project = PROJ_LATLON
  92    else if (grid%map_proj == 1) then
  93       map_util_project = PROJ_LC
  94    else if (grid%map_proj == 2) then
  95       map_util_project = PROJ_PS
  96    else if (grid%map_proj == 3) then
  97       map_util_project = PROJ_MERC
  98    end if
  99
 100    call da_map_set(map_util_project,grid%cen_lat,grid%cen_lon,   &
 101                 real(grid%xp%ide-grid%xp%ids+2)/2.0, real(grid%xp%jde-grid%xp%jds+2)/2.0, &
 102                 grid%dx,grid%stand_lon,grid%truelat1,grid%truelat2,latinc,loninc,map_info)
 103    ! Need to set map projection in WRF world.
 104    map_projection = grid%map_proj
 105    cone_factor = map_info%cone
 106
 107    if (print_detail_map) then
 108       write(unit=stdout, fmt='(a, i6)') &
 109            'map_proj =', grid%map_proj
 110
 111       write(unit=stdout, fmt='(a, e16.6)') &
 112            'cen_lat  =', grid%cen_lat,  &
 113            'cen_lon  =', grid%cen_lon,  &
 114            'truelat1 =', grid%truelat1, &
 115            'truelat2 =', grid%truelat2, &
 116            'start_lat =', start_lat, &
 117            'start_lon =', start_lon, &
 118            'latinc    =', latinc   , &
 119            'loninc    =', loninc   , &
 120            'cone_fact =', cone_factor, &
 121            'dsm      =', dsm
 122    end if
 123
 124
 125     mix = grid%xp%ide - grid%xp%ids  + 1
 126     mjy = grid%xp%jde - grid% xp%jds + 1
 127     mkz = grid%xp%kde - grid%xp%kds  + 1
 128
 129    call da_transfer_wrf_nmm_regional_toxb(xbx, grid)
 130
 131    if (trace_use) call da_trace_exit("da_setup_firstguess_wrf_nmm_regional")
 132
 133 end subroutine da_setup_firstguess_wrf_nmm_regional
 134
 135