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