var/da/da_setup_structures/da_setup_firstguess_wrf.inc

   1 subroutine da_setup_firstguess_wrf(xbx, grid, config_flags, ens)
   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    logical, intent(in) :: ens
  14
  15    integer           :: map_util_project
  16    real              :: x, y, lat_cen, lon_cen
  17
  18    real              :: buf(2)
  19
  20    character(len=24) :: xb_date, an_date
  21    integer           :: len, seconds, i_grid,  j_grid, m_expand
  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          message(1)="The time of your first guess file is different from the analysis date"
  42          write(unit=message(2),fmt='(A,A)') &
  43              "xb_date    = ",xb_date
  44          write(unit=message(3),fmt='(A,A)') &
  45              "an_date    = ",an_date
  46          write(unit=message(4),fmt='(A,I10,A)') &
  47             "Difference between analysis_date and first guess date is ",seconds," seconds."
  48          message(5)="Correct your choice of fg file, or change analysis_date or analysis_accu in namelist.input"
  49          call da_error(__FILE__,__LINE__,message(1:5))
  50       end if
  51    end if
  52
  53    !------------------------------------------------------------------------
  54    ! [1.0] Read original WRF format first guess:
  55    !------------------------------------------------------------------------
  56
  57    !------------------------------------------------------------------------
  58    ! [2.0] Copy header info:
  59    !------------------------------------------------------------------------
  60
  61    if ((grid%xp%its == grid%xp%ids) .and. (grid%xp%jts == grid%xp%jds)) then
  62       buf(1) = grid%xlat(grid%xp%its, grid%xp%jts)
  63       buf(2) = grid%xlong(grid%xp%its, grid%xp%jts)
  64    end if
  65
  66    call wrf_dm_bcast_real(buf, 2)
  67    start_lat=buf(1)
  68    start_lon=buf(2)
  69
  70    !------------------------------------------------------------------------
  71    ! Setup map utility
  72    !------------------------------------------------------------------------
  73
  74    call nl_get_map_proj     (grid%id , grid%map_proj)
  75    call nl_get_truelat1     (grid%id , grid%truelat1)
  76    call nl_get_truelat2     (grid%id , grid%truelat2)
  77    call nl_get_dx           (grid%id , grid%dx)
  78    call nl_get_cen_lat      (grid%id , grid%cen_lat)
  79    call nl_get_cen_lon      (grid%id , grid%cen_lon)
  80    call nl_get_pole_lat     (grid%id , grid%pole_lat)
  81    call nl_get_moad_cen_lat (grid%id , grid%moad_cen_lat)
  82    call nl_get_stand_lon    (grid%id , grid%stand_lon)
  83
  84    phic = grid%moad_cen_lat
  85    xlonc = grid%stand_lon
  86
  87    truelat1_3dv = grid%truelat1
  88    truelat2_3dv = grid%truelat2
  89    pole = 90.0
  90    dsm = 0.001 * grid%dx
  91
  92    map_util_project = grid%map_proj
  93
  94    ! Print mapping info to log file(s)
  95    write(unit=message(1), fmt='(a)') 'Domain mapping info:'
  96    write(unit=message(2), fmt='(a, i6)') &
  97         'map_proj =', grid%map_proj
  98    write(unit=message(3), fmt='(a, e16.6)') &
  99         'cen_lat   =', grid%cen_lat
 100    write(unit=message(4), fmt='(a, e16.6)') &
 101         'cen_lon   =', grid%cen_lon
 102    write(unit=message(5), fmt='(a, e16.6)') &
 103         'truelat1  =', grid%truelat1
 104    write(unit=message(6), fmt='(a, e16.6)') &
 105         'truelat2  =', grid%truelat2
 106    write(unit=message(7), fmt='(a, e16.6)') &
 107         'start_lat =', start_lat
 108    write(unit=message(8), fmt='(a, e16.6)') &
 109         'start_lon =', start_lon
 110    write(unit=message(9), fmt='(a, e16.6)') &
 111         'pole_lat  =', grid%pole_lat
 112    write(unit=message(10), fmt='(a, e16.6)') &
 113         'dsm       =', dsm
 114    call da_message(message(1:10))
 115
 116    ! Set map projection in WRFSI world.
 117    map_util_project = PROJ_LC
 118
 119    if (grid%map_proj == 0 .or. grid%map_proj == 6 ) then
 120       map_util_project = PROJ_LATLON
 121
 122       if (grid%pole_lat < 89.9) then
 123          write(unit=message(1),fmt='(A,E10.6)')'POLE_LAT = ',grid%pole_lat
 124          write(unit=message(2),fmt='(A)')"WRFDA does not support rotated cylindrical equidistant projection"
 125          write(unit=message(3),fmt='(A)')"Choose a first guess file with a valid projection"
 126          call da_error(__FILE__,__LINE__,message(1:3))
 127       end if
 128    else if (grid%map_proj == 1) then
 129       map_util_project = PROJ_LC
 130    else if (grid%map_proj == 2) then
 131       map_util_project = PROJ_PS
 132    else if (grid%map_proj == 3) then
 133       map_util_project = PROJ_MERC
 134    else
 135       write(unit=message(1),fmt='(A,I6)')'map_proj = ',grid%map_proj
 136       write(unit=message(2),fmt='(A)')"WRFDA does not support the selected map projection"
 137       write(unit=message(3),fmt='(A)')"Choose a first guess file with a valid projection"
 138       call da_error(__FILE__,__LINE__,message(1:3))
 139    end if
 140
 141    call da_map_set(map_util_project,grid%cen_lat,grid%cen_lon,   &
 142                 real(grid%xp%ide-grid%xp%ids+2)/2.0, real(grid%xp%jde-grid%xp%jds+2)/2.0, &
 143                 grid%dx,grid%stand_lon,grid%truelat1,grid%truelat2,grid%truelat1,grid%stand_lon,map_info)
 144
 145    ! Need to set map projection in WRF world.
 146    map_projection = grid%map_proj
 147
 148    cone_factor = map_info%cone
 149
 150    if (.not. global .and. print_detail_map) then
 151
 152       !----------------------------------------------------------------------
 153       ! Check the ll_to_ij:
 154       !----------------------------------------------------------------------
 155
 156       message(1)="Check the map_set correctness::::::::::::::::::::::::"
 157
 158       ! Domain center:
 159       call  da_llxy_wrf(map_info, grid%cen_lat, grid%cen_lon, start_x, start_y)
 160       write(unit=message(2),fmt='("Center: latc,lonc,x,y, Xc, Yc:",6f10.3)') &
 161                   grid%cen_lat, grid%cen_lon, start_x, start_y, &
 162                   real(grid%xp%ide-grid%xp%ids+2)/2.0, real(grid%xp%jde-grid%xp%jds+2)/2.0
 163
 164       start_x = real(grid%xp%ide-grid%xp%ids+2)/2.0
 165       start_y = real(grid%xp%jde-grid%xp%jds+2)/2.0
 166       lat_cen = -999.9
 167       lon_cen = -999.9
 168       call  da_xyll(map_info, start_x, start_y, lat_cen, lon_cen)
 169       write(unit=message(3), &
 170          fmt='("Center: X, Y, latc, lonc, phic, xlonc:",6f10.3)') &
 171          start_x, start_y, lat_cen, lon_cen,   &
 172          grid%cen_lat, grid%cen_lon
 173       call da_message(message(1:3))
 174    end if
 175
 176    ! Setup the domain definition for use of the GRAPH:
 177
 178    coarse_ds = 0.001 * grid%dx
 179    coarse_ix = grid%e_we - grid%s_we + 1
 180    coarse_jy = grid%e_sn - grid%s_sn + 1
 181    start_x = 1.0
 182    start_y = 1.0
 183
 184    if( fg_format==fg_format_kma_global) then
 185    delt_lat = 180.0/real(grid%e_sn - grid%s_sn - 1)
 186    delt_lon = 360.0/real(grid%e_we - grid%s_we)
 187    else if( fg_format==fg_format_wrf_arw_global) then
 188    delt_lat = 180.0/real(grid%e_sn - grid%s_sn)
 189    delt_lon = 360.0/real(grid%e_we - grid%s_we)
 190    end if
 191
 192    !--------------------------------------------------------------------------
 193    ! [3.0] Interpolate WRF C-grid winds to p points of WRFVAR grid (interpolate
 194    ! u to west, v to south?
 195    !---------------------------------------------------------------------------
 196
 197    grid%xb % mix = grid%xp%ide - grid%xp%ids + 1
 198    grid%xb % mjy = grid%xp%jde - grid% xp%jds + 1
 199    grid%xb % mkz = grid%xp%kde - grid%xp%kds + 1
 200
 201    grid%xb % ds  = 0.001 * grid%dx
 202
 203    mix = grid%xb % mix
 204    mjy = grid%xb % mjy
 205    mkz = grid%xb % mkz
 206
 207 #if (WRF_CHEM == 1)
 208    call da_transfer_wrftoxb_chem(grid)
 209 #endif
 210
 211    if ( .not. ens ) then
 212       call da_transfer_wrftoxb(xbx, grid, config_flags)
 213    endif
 214
 215    if (trace_use) call da_trace_exit("da_setup_firstguess_wrf")
 216
 217 end subroutine da_setup_firstguess_wrf
 218
 219