da_setup_firstguess_kma.inc

1 subroutine da_setup_firstguess_kma(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           :: i, j
14    integer           :: is, ie, js, je
15    integer           :: max_wavenumber
16 
17    if (trace_use) call da_trace_entry("da_setup_firstguess_kma")
18 
19    is = grid%xp % its
20    ie = grid%xp % ite
21    js = grid%xp % jts
22    je = grid%xp % jte
23 
24    !------------------------------------------------------------------------
25    ! [2.0] Copy header info:
26    !------------------------------------------------------------------------
27 
28    ! rizvi set it to 1 . Actually it should be decided by KMA 
29    grid%map_proj = 0
30    map_projection = grid%map_proj
31    coarse_ix = grid%e_we - grid%s_we + 1
32    coarse_jy = grid%e_sn - grid%s_sn + 1
33 
34    grid%xb % mix = grid%xp%ide - grid%xp%ids + 1
35    grid%xb % mjy = grid%xp%jde - grid%xp%jds + 1
36    grid%xb % mkz = grid%xp%kde - grid%xp%kds + 1
37 
38    mix = grid%xb % mix
39    mjy = grid%xb % mjy
40    mkz = grid%xb % mkz
41 
42    grid%xb % ds  = 0.001 * grid%dx
43 
44    start_x = 1.0
45    start_y = 1.0
46    start_lat = -90.0
47    start_lon = -180.0
48    delt_lat = 180.0/real(grid%e_sn - grid%s_sn - 1)
49    delt_lon = 360.0/real(grid%e_we - grid%s_we)
50 
51    phic        = 0.0
52    xlonc       = 0.0
53    cone_factor = 0.0
54 
55 
56    do j = js,je
57       do i = is,ie
58          grid%xlat(i,j) = start_lat + real(j-1)*delt_lat
59          grid%xlong(i,j) = start_lon + real(i-1)*delt_lon
60       end do
61    end do
62 
63    ! Avoid assigning -90,90 value                                           
64    if (grid%xb%jts == grid%xb%jds) then
65       grid%xlat(is:ie,j) = -89.9                               
66    end if
67 
68    if (grid%xb%jte == grid%xb%jde) then
69       grid%xlat(is:ie,j) = 89.9                               
70    end if
71 
72    ! fix map factor and coriolis parameter
73       
74    grid%f(is:ie,js:je) = 2.0 *earth_omega*sin(pi*grid%xlat(is:ie,js:je)/180.0)
75 
76    xbx%inc = 1
77    xbx%ni  = grid%e_we - grid%s_we
78    xbx%nj  = grid%e_sn - grid%s_sn
79    xbx%nk  = grid%e_vert - 1
80    xbx% lenwrk    = xbx%ni
81    xbx% lenr           = xbx%inc * (xbx%ni - 1) + 1
82    max_wavenumber = xbx%ni/2-1
83    xbx % alp_size = (xbx%nj+1)*(max_wavenumber+1)*(max_wavenumber+2)/4
84 
85    call da_transfer_kmatoxb(xbx, grid)
86 
87    if (trace_use) call da_trace_exit("da_setup_firstguess_kma")
88 
89 end subroutine da_setup_firstguess_kma
90 
91